!-------------------------------------- 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 stdevout,10
#if defined (DOC)
*
***s/r stdevout  - Write global background error st-dev on RPN
*    .             standard file
*
*Author  : L. Fillion - ARMA/EC - Feb 2007.
*Revision: 
* L. Fillion - ARMA/EC - Sept 2009 - Extend output of Balanced, Unbalanced and Total background-error st-dev.
* L. Fillion - ARMA/EC - 19 Mar 2010 - Include Tg.
*

*Arguments
*
#endif
C
      IMPLICIT NONE
*implicits
#include "taglam4d.cdk"
#include "pardim.cdk"
#include "comdim.cdk"
#include "comlun.cdk"
#include "comcst.cdk"
#include "comgem.cdk"
#include "compost.cdk"
#include "cvcord.cdk"
#include "rpnstd.cdk"
#include "comgdpar.cdk"
#include "cominterp.cdk"
#include "comct0.cdk"
#include "comfilt.cdk"
#include "comgd0.cdk"
#include "comsim.cdk"
#include "compdg.cdk"
#include "comspg.cdk"
#include "comcorr.cdk"
#include "comcva.cdk"
#include "compstat.cdk"
*
      integer nvar,initer
      parameter (nvar=8)
      character*8 clletiket
!
      logical lladiab,llconv,llcond,lltcorr,lldiab
      character*1 cllgrtyp
      character*2 clvar
      integer VFSTLUK,fstecr
      integer jlev,imode,ilev,ji,jj,jk,jpt
      integer imaxlev
      parameter(imaxlev=200)
      integer itrlgid,iip1s(imaxlev),iip2,iip3
      integer itrlnlev
!      integer iig1,iig2,iig3,iig4,ikey
      integer ikind,ibrpstamp
      integer ezgprm
      integer idum1,idum2,idum3,idum4
      integer ip1_pak_trl,ip1_vco_trl
      integer :: k,koutmpg  !  the unit which has the selected records.
!
      real*8 zmin,zmax,zpt,ztstar
      real*8 zeta(nflev)
      real*8 zfldin(ni,nj,nflev),zwork
!
      character*1 cltypinc,clstring
      character*2 cvar(nvar)

      integer iunit
!      integer fnom,fstouv,iunit,fstfrm
      integer jvar,idim,iig1
!      integer fstopc,ezqkdef,igdgid,idatyp

!
!!
      iunit=nulinclr
!      IERR = FNOM(iunit,'stdevout.fst','RND',0)
!      IERR = FSTOUV(iunit,'RND')
!
! Psi
      do jlev=1,nflev
        do jj=1,nj
          do ji=1,ni
            zfldin(ji,jj,jlev) = rgsiguu(jj,jlev)
          enddo
        enddo
      enddo
!      call maxmin(zfldin,ni,nflev,nj,zmin,zmax,
!     &            idum1,idum2,idum3,idum4,'stdevout    ',
!     &            'PP ')
!
      clletiket='PPGLDEV'
      call ecr_gu(zfldin,'PP',niter,clletiket,iunit,ni,nj,nflev)
!
! Chiu
      do jlev=1,nflev
        do jj=1,nj
          do ji=1,ni
            zfldin(ji,jj,jlev) = rgsigvv(jj,jlev)
          enddo
        enddo
      enddo
!      call maxmin(zfldin,ni,nflev,nj,zmin,zmax,
!     &            idum1,idum2,idum3,idum4,'stdevout    ',
!     &            'CU ')
      clletiket='CUGLDEV'
      call ecr_gu(zfldin,'CC',niter,clletiket,iunit,ni,nj,nflev)
!
! Tu
      if(mbal_order.eq.0) then
        do jlev=1,nflev
          do jj=1,nj
            do ji=1,ni
              zfldin(ji,jj,jlev) = sqrt(rgsigtt(jj,jlev)**2 - rgsigtb(jj,jlev)**2)
            enddo
          enddo
          write(nulout,*) 'stdevout: jlev,sig_tu(1,nj/4,jlev)=',zfldin(1,nj/4,jlev)
        enddo
      else
        do jlev=1,nflev
          do jj=1,nj
            do ji=1,ni
              zfldin(ji,jj,jlev) = rgsigtt(jj,jlev)
            enddo
          enddo
          write(nulout,*) 'stdevout: jlev,sig_tu(1,nj/4,jlev)=',zfldin(1,nj/4,jlev)
        enddo
      endif
!
!      call maxmin(zfldin,ni,nflev,nj,zmin,zmax,
!     &            idum1,idum2,idum3,idum4,'stdevout    ',
!     &            'TU ')
!
      clletiket='TUGLDEV'
      call ecr_gu(zfldin,'TT',niter,clletiket,iunit,ni,nj,nflev)
!
! Tb
      do jlev=1,nflev
        do jj=1,nj
          do ji=1,ni
            zfldin(ji,jj,jlev) = rgsigtb(jj,jlev)
          enddo
        enddo
      enddo
!
!      call maxmin(zfldin,ni,nflev,nj,zmin,zmax,
!     &            idum1,idum2,idum3,idum4,'stdevout    ',
!     &            'TB ')
!
      clletiket='TBGLDEV'
      call ecr_gu(zfldin,'TT',niter,clletiket,iunit,ni,nj,nflev)
!
! TT
      if(mbal_order.eq.0) then
        do jlev=1,nflev
          do jj=1,nj
            do ji=1,ni
              zfldin(ji,jj,jlev) = rgsigtt(jj,jlev)
            enddo
          enddo
        enddo
      else
        do jlev=1,nflev
          do jj=1,nj
            do ji=1,ni
              zfldin(ji,jj,jlev) = sqrt(rgsigtt(jj,jlev)**2 + rgsigtb(jj,jlev)**2)
            enddo
          enddo
        enddo
      endif
!
!      call maxmin(zfldin,ni,nflev,nj,zmin,zmax,
!     &            idum1,idum2,idum3,idum4,'stdevout    ',
!     &            'TT ')
!
      clletiket='TTGLDEV'
      call ecr_gu(zfldin,'TT',niter,clletiket,iunit,ni,nj,nflev)
!
! Lnq
      do jlev=1,nflev
        do jj=1,nj
          do ji=1,ni
            zfldin(ji,jj,jlev) = rgsigq(jj,jlev)
          enddo
        enddo
      enddo
!
!      call maxmin(zfldin,ni,nflev,nj,zmin,zmax,
!     &            idum1,idum2,idum3,idum4,'stdevout    ',
!     &            'LQ ')
!
      clletiket='LQGLDEV'
      call ecr_gu(zfldin,'HU',niter,clletiket,iunit,ni,nj,nflev)
!
! Psu
      if(mbal_order.eq.0) then
        do jj=1,nj
          do ji=1,ni
            zfldin(ji,jj,1) = sqrt(rgsigps(jj,1)**2 - rgsigpsb(jj)**2)
          enddo
          write(nulout,*) 'stdevout: jj,psb,psu=',
     &         jj,rgsigpsb(jj),zfldin(1,jj,1)
        enddo
      else
        do jj=1,nj
          do ji=1,ni
            zfldin(ji,jj,1) = rgsigps(jj,1)
          enddo
          write(nulout,*) 'stdevout: jj,psu=',
     &         jj,zfldin(1,jj,1)
        enddo
      endif
!
!      call maxmin(zfldin,ni,1,nj,zmin,zmax,
!     &            idum1,idum2,idum3,idum4,'stdevout    ',
!     &            'PSU')
!
      clletiket='PSUGLDEV'
      call ecr_gu(zfldin,'P0',niter,clletiket,iunit,ni,nj,1)
!
! Psb
      do jj=1,nj
        do ji=1,ni
          zfldin(ji,jj,1) = rgsigpsb(jj)
        enddo
        write(nulout,*) 'stdevout: jj,rgsigpsb(jj)=',jj,rgsigpsb(jj)
      enddo
!
!      call maxmin(zfldin,ni,1,nj,zmin,zmax,
!     &            idum1,idum2,idum3,idum4,'stdevout    ',
!     &            'PSB')
!
      clletiket='PSBGLDEV'
      call ecr_gu(zfldin,'P0',niter,clletiket,iunit,ni,nj,1)
!
! Ps
      if(mbal_order.eq.0) then
        do jj=1,nj
          do ji=1,ni
            zfldin(ji,jj,1) = rgsigps(jj,1)
          enddo
        enddo
      else
        do jj=1,nj
          do ji=1,ni
            zfldin(ji,jj,1) = sqrt(rgsigps(jj,1)**2 + rgsigpsb(jj)**2)
          enddo
        enddo
      endif
!
!      call maxmin(zfldin,ni,1,nj,zmin,zmax,
!     &            idum1,idum2,idum3,idum4,'stdevout    ',
!     &            'PS ')
!
      clletiket='PSGLDEV'
      call ecr_gu(zfldin,'P0',niter,clletiket,iunit,ni,nj,1)
!
! Tg
      do jj=1,nj
        do ji=1,ni
          zfldin(ji,jj,1) = tgstdbg(ji,jj)
        enddo
      enddo
!
      clletiket='TGGLDEV'
      call ecr_gu(zfldin,'TG',niter,clletiket,iunit,ni,nj,1)
!
      return
      end