!-------------------------------------- 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 --------------------------------------
!
!
!  X X X X X X X X X X X X X X X X X X X X X X X X X X X X X X X X X X X
!

      subroutine tinvlap(koutfile,kdateo) 1,14
C
C**** tinvlap  - Tests invlap.ftn. Just call it in meancvgd.ftn at the end.
C
C
C AUTHOR: Luc Fillion - ARMA/EC - 8 Jun 2009.
C
C MODIFICATIONS.
C
      IMPLICIT NONE
#include "taglam4d.cdk"
#include "comlun.cdk"
#include "pardim.cdk"
#include "comdim.cdk"
#include "comcst.cdk"
#include "comct0.cdk"
#include "cvcord.cdk"
#include "comgrd_param.cdk"
#include "comgem.cdk"
#include "comgemla.cdk"
#include "comgrd.cdk"
*
      integer koutfile
!
      character*8 cletik
      CHARACTER*1 CLTYPVAR,CLGRTYP
      CHARACTER*2 CLNOMVAR
      CHARACTER*8 CLETIKET
      logical llsp
      integer ji,jj,jla,jk,jlev,ierr
      integer vfstecr
      integer ilev,iwvx,iwvy
      integer idum1,idum2,idum3,idum4
      INTEGER ibrpstamp,iulout
      INTEGER IPAK, KDATEO
      INTEGER INI,INJ,INK, INPAS, INBITS, IDATYP, IDEET
     +     ,IP1,IP2,IP3,IG1,IG2,IG3,IG4,ISWA,ILENGTH,IDLTF
     +     ,IUBC,IEXTR1,IEXTR2,IEXTR3
      real*8 zmin,zmax
      real*8 zsum,zlpsi,zvalue
      real*8 zgd(ni,nj)
      real*8 zvort(ni,nj)
      real*8 zgdpsi(ni,nj)
      real*8 zgdpsi_euclid(ni,nj)
      real*8 zfld(ni,nj)
      real*8 z2d(ni,nj)
      real*8 zfldin(mni_in,mnj_in)
      real*8 zsp(nla,2)
      real*8 zwlap(ni,nj)
      real*8 zwh(ni,nj)
      real*8 zx8(ni),zy8(nj)
*
**
      print *,' '
      print *,'*****************'
      print *,'tinvlap'
      print *,'*****************'
      print *,' '
!
      zlpsi= 100.e3
      call cormdl(zgd,zlpsi,'G',1,ni/2,nj/2,1)
      call maxmin(zgd,ni,nj,1,zmin,zmax,
     &            idum1,idum2,idum3,idum4,'tinvlap',
     &            'ZGD')
!
      do ji=1,ni
        do jj=1,nj
          zwh(ji,jj)=zgd(ji,jj)
        enddo
      enddo
      call lap(zwlap,zwh,'P')
      do ji=1,ni
        do jj=1,nj
          zvort(ji,jj)=zwlap(ji,jj)
        enddo
      enddo
!
      call invlap(zgdpsi,zvort,'P',.true.)
!
      call re2spla(zsp,zvort,1)
      call invlap_euclid(zgdpsi_euclid,zsp,1)

!
! Write on file
!
      ibrpstamp=nbrpstamp
      IPAK = -32
      IDATYP = 5
      IP1      =  NIP1(1)
      IP2 = 0
      IP3 = 0
      cltypvar = 'E'
!
      jlev=1
      do jj=1,nj
        do ji=1,ni
          z2d(ji,jj) = zgd(ji,jj)
        enddo
      enddo
      cletik = 'PSI-ORI'
      write(nulout,*) 'tinvlap: writing PSI-ORI'
      call maxmin(z2d,ni,nj,1,zmin,zmax,
     &            idum1,idum2,idum3,idum4,'tinvlap',
     &            'PP ')
      IERR = VFSTECR(z2d,z2d,IPAK,koutfile,
     &            KDATEO,0,0,ni,nj,1,IP1,IP2,IP3,'E','PP',cletik,
     &            'Z',mig1flda,mig2flda,mig3flda,0,IDATYP,.TRUE.)

!
        do jj=1,nj
          do ji=1,ni
            z2d(ji,jj) = zvort(ji,jj)
          enddo
        enddo
      cletik = 'ZVORT'
      call maxmin(z2d,ni,nj,1,zmin,zmax,
     &            idum1,idum2,idum3,idum4,'tinvlap',
     &            'VOR')
      IERR = VFSTECR(z2d,z2d,IPAK,koutfile,
     &            KDATEO,0,0,ni,nj,1,IP1,IP2,IP3,'E','QQ',cletik,
     &            'Z',mig1flda,mig2flda,mig3flda,0,IDATYP,.TRUE.)
!
        do jj=1,nj
          do ji=1,ni
            z2d(ji,jj) = zgdpsi(ji,jj)
          enddo
        enddo
      cletik = 'ZGDPSI'
      call maxmin(z2d,ni,nj,1,zmin,zmax,
     &            idum1,idum2,idum3,idum4,'tinvlap',
     &            'PP ')
      IERR = VFSTECR(z2d,z2d,IPAK,koutfile,
     &            KDATEO,0,0,ni,nj,1,IP1,IP2,IP3,'E','PP',cletik,
     &            'Z',mig1flda,mig2flda,mig3flda,0,IDATYP,.TRUE.)
!
        do jj=1,nj
          do ji=1,ni
            z2d(ji,jj) = zgdpsi_euclid(ji,jj)
          enddo
        enddo
      cletik = 'PSI-EUCL'
      call maxmin(z2d,ni,nj,1,zmin,zmax,
     &            idum1,idum2,idum3,idum4,'tinvlap',
     &            'PP ')
      IERR = VFSTECR(z2d,z2d,IPAK,koutfile,
     &            KDATEO,0,0,ni,nj,1,IP1,IP2,IP3,'E','PP',cletik,
     &            'Z',mig1flda,mig2flda,mig3flda,0,IDATYP,.TRUE.)
!
      return
      end