SUBROUTINE GENINCR 1,7
#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
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