!-------------------------------------- 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 ecr_la(pin,cdvar,kniter,cdetiket,kpak,kbrpstamp,kdeet,kpas, 14,2
     &                  kdatyp,cdtypinc,ldasis,kfile,kni,knj,knk)
#if defined (DOC)
*
***s/r ecr_la  - Write content of input array pin onto kfile RPN standard file.
*
*Author  : L. Fillion - ARMA/MSC - 30 Aug 2005.
*Revision: L. Fillion - ARMA/MSC - 16 March 2006 - Extend to also output a surface field.
*Revision: L. Fillion - ARMA/EC - 5 May 2008 - Introduce file flexibility through kfile argument.
*                        N.B.: It is assumed the RPN std file kfile has previously been declarted and opened.
*Revision: L. Fillion - ARMA/EC - 22 Apr 2009 - Introduce ldasis to write in same input units.

*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 "comsim.cdk"
#include "comgrd_param.cdk"
#include "comgrd.cdk"
#include "comgemla.cdk"
*
      logical ldasis
      integer nvar,kniter,kni,knj,knk,kfile
      integer kpak,kbrpstamp,kdeet,kpas,kdatyp
      character*1 cdtypinc
      parameter (nvar=8)
      character*3 cdvar
      character*8 cdetiket
      real*8 pin(kni,knj,knk)
!
      integer VFSTLUK
      integer jlev,imode,ilev,ji,jj,jk
      integer imaxlev
      parameter(imaxlev=200)
      integer itrlgid,iip1s(imaxlev),iip2,iip3
      integer itrlnlev
      integer iig2,iig3,iig4,ikey
      integer ikind
      integer ezgprm
      integer idum1,idum2,idum3,idum4
!
      character*1 cltypinc,clstring
      character*2 cvar(nvar)
      integer jvar,ii,ij,idim,iig1
      integer fstopc,iflag
      real*8 zmin,zmax,ZGEOP,ZDAM,zcon
      real*8 zwork
      real*8 zin(kni,knj,knk)
!
!!
      ip1 = -1
      ip2 = 0
      ip3 = kniter
      jlev = 1
!
      ZGEOP  = 10. * RG
      ZDAM   = 1./ZGEOP
!
      zcon = 1.0
      if(cdvar.eq.'GZ ') then
        zcon = zdam
      else if(cdvar.eq.'P0 ') then
        zcon = rpatmb
      endif
!
      if(ldasis) zcon = 1.0
!
      iflag = 0
      zin(:,:,:) = 0.0
      do ji=1,kni
        do jj=1,knj
          do jk=1,knk
            zin(ji,jj,jk)=zcon*pin(ji,jj,jk) 
            if(zin(ji,jj,jk).ne.0.0) iflag = 1
          enddo
        enddo
      enddo
      if(iflag.eq.0.0) write(nulout,*) 'ecr_la: output field identically zero'
!    
      if(knk.eq.1) then
        IP1 =  NIP1(NFLEV)
        write(nulout,*) 'ecr_la: IP1,kfile,kbrpstamp=',IP1,kfile,kbrpstamp
        IERR  = VFSTECR(zin(1,1,1),zin(1,1,1),kpak,
     &                  kfile,kbrpstamp,kdeet,kpas,kni,knj,1,
     &                  ip1,ip2,ip3,cdtypinc,cdvar,cdetiket,'Z',
     &                  mig1in,mig2in,mig3in,0,kdatyp,.true.)
      else
        do while (jlev.le.nflev.and.ip1.ne.0)
          IP1 =  NIP1(jLEV)
          IERR  = VFSTECR(zin(1,1,jlev),zin(1,1,jlev),kpak,
     &                    kfile,kbrpstamp,kdeet,kpas,kni,knj,1,
     &                    ip1,ip2,ip3,cdtypinc,cdvar,cdetiket,'Z',
     &                    mig1in,mig2in,mig3in,0,kdatyp,.true.)
!
          jlev = jlev + 1
        enddo
      endif
!
      return
      end