!-------------------------------------- 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 GENINCR 1,23
#if defined (DOC)
*
***s/r GENINCR- To derive increment in terms of the analysis
*     .         variables for a single element
*
*
*Author  : P. Gauthier *ARMA/AES  March 31, 1998
*Revision:
*
*Arguments
*
#endif
      IMPLICIT NONE
*implicits
#include "pardim.cdk"
#include "comdim.cdk"
#include "comlun.cdk"
#include "comgem.cdk"
#include "comgd0.cdk"
#include "comgd1.cdk"
#include "compost.cdk"
#include "comgdpar.cdk"
#include "localpost.cdk"
#include "rpnstd.cdk"
*
*
*     Local variables
*
*
      INTEGER ILON, JLEV, JLON, JLAT, JLA
      REAL*8 ZCORIOLIS, ZDAM, ZGEOP
      REAL*8 DLA2, DL1SA2
      LOGICAL LLINBAL
      INTEGER ILEN,ILEN2
      CHARACTER*8 CLBALETIK
C
C     0. Allocate local arrays and initialize to zero
C
*     Initialization of localpost.cdk
*
      ILEN = NI*NFLEV*NJ
      ILEN2= NI*NJ
      CALL HPALLOC(PXPP,MAX(1,ILEN),IERR,8)
      CALL HPALLOC(PXQQ,MAX(1,ILEN),IERR,8)
      CALL HPALLOC(PXCC,MAX(1,ILEN),IERR,8)
      CALL HPALLOC(PXUC,MAX(1,ILEN),IERR,8)
      CALL HPALLOC(PXQR,MAX(1,ILEN),IERR,8)
      CALL HPALLOC(PXDD,MAX(1,ILEN),IERR,8)
      CALL HPALLOC(PXGP,MAX(1,ILEN),IERR,8)
      CALL HPALLOC(PXGB,MAX(1,ILEN),IERR,8)
      CALL HPALLOC(PXTP,MAX(1,ILEN),IERR,8)
      CALL HPALLOC(PXLPP,MAX(1,ILEN2),IERR,8)
cjmb
      CALL HPALLOC(PXGZB,MAX(1,ILEN),IERR,8)
*
      CALL ZERO(ILEN,ZQQ(1,1,1))
      CALL ZERO(ILEN,ZQR(1,1,1))
      CALL ZERO(ILEN,ZPP(1,1,1))
      CALL ZERO(ILEN,ZDD(1,1,1))
      CALL ZERO(ILEN,ZCC(1,1,1))
      CALL ZERO(ILEN,ZUC(1,1,1))
      CALL ZERO(ILEN,ZGP(1,1,1))
      CALL ZERO(ILEN,ZGB(1,1,1))
      CALL ZERO(ILEN,ZTP(1,1,1))
      CALL ZERO(ILEN2,ZLPP(1,1,1))
cjmb
      CALL ZERO(ILEN,ZGZB(1,1,1))
c
      CALL READNML('NAMGDPAR',IERR)
      CALL READNML('NAMCVA',IERR)
      CALL READNML('NAMCSE1',IERR)
C
C     0.  Read in the balance operators
C
      CALL READPTOT
*
*     1.  Read the model state
*
      CTYPVARA = 'E'
      CALL GETFST(NINMPG,'G','A')
      CALL GETPARAM(NINMPG)
*
      CALL GDSP
      CALL SPGD
C
C call subroutine to generate Psi, Chi_b, T_b, ps_b (in ut1,vt1,tt1,gps1)
C -->>input is vorticity (in spvor)
C
      CALL BTLNPSR
C
C full T,Ps are still in tt0,gps0
C put unbalanced T,Ps into ZTP,ZLPP
      DO JLAT = 1, NJ
         ILON = NILON(JLAT)
         DO JLON = 1, ILON
            DO JLEV = 1, NFLEV
               ZTP(JLON,JLEV,JLAT) = TT0(JLON,JLEV,JLAT)
     S                             - TT1(JLON,JLEV,JLAT)
            ENDDO
            ZLPP(JLON,1,JLAT) = GPS0(JLON,1,JLAT)
     +                        - GPS1(JLON,1,JLAT)
         END DO
      END DO

      DO JLEV = 1, NFLEV
         DO JLAT = 1, NJ
            ILON = NILON(JLAT)
            DO JLON = 1, ILON
C put PSI,CHI into ZPP,ZCC
               ZPP(JLON,JLEV,JLAT)= UT0(JLON,JLEV,JLAT)
               ZCC(JLON,JLEV,JLAT)= VT0(JLON,JLEV,JLAT)
C calculate unbalanced CHI in ZUC
               ZUC(JLON,JLEV,JLAT)= VT0(JLON,JLEV,JLAT)
     +                             -VT1(JLON,JLEV,JLAT)
cjmb
               ZGZB(JLON,JLEV,JLAT)= GZ1(JLON,JLEV,JLAT)
             END DO
         END DO
      END DO
C
C   put Ps_b in gps0, P_b in gz0, T_b in tt0 (overwriting full fields
C                                               from original file)
      CALL TRANSFER('GD10')
*
*     3. Write everything out to std_file
*
      CALL SUPOST
      NIP2   = IP2
      NIG1   = IG1
      NIG2   = IG2
      NIG3   = IG3
      NIG4   = IG4
      NDEET  = IDEET
      NPAS   = IPAS
      NSTAMP = IDATE(1)
      CGRTYP = CLGRTYP
      NPAK   = -INBITS
      CVARPOST =CLTYPVAR
      CALL POSTPROC(NULSTD,IP3,'GRID',CLETIKET)
*
*     4. Deallocate local arrays
*     .  (contained in localpost.cdk)
*
      CALL HPDEALLC(PXPP,IERR,1)
      CALL HPDEALLC(PXQQ,IERR,1)
      CALL HPDEALLC(PXCC,IERR,1)
      CALL HPDEALLC(PXUC,IERR,1)
      CALL HPDEALLC(PXQR,IERR,1)
      CALL HPDEALLC(PXDD,IERR,1)
      CALL HPDEALLC(PXGP,IERR,1)
      CALL HPDEALLC(PXGB,IERR,1)
      CALL HPDEALLC(PXTP,IERR,1)
      CALL HPDEALLC(PXLPP,IERR,1)
*
      RETURN
      END