!-------------------------------------- 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 POSTPROC(KULOUT,KITER,CDPPTYP,CDETIKET) 23,38
use modstag
, only : lstagwinds
#if defined (DOC)
*
***s/r POSTPROC - post-processing of the model state
* .
*
*Author : P. Gauthier *ARMA/AES Sept. 20, 1993
* .
*Revision:
* . P. Koclas *CMC/CMDA February 1994
* . -New call sequence to gdout.
* . -Change TYPVAR to 'A' or 'R
* . Depending on value of CDPPTYP
* . L. Fillion *ARMA/AES Nov 94
* -Take into account the new control variable
* Validated for the case NCNTVAR = 2 and CFGERR.EQ.'G' only.
* . L. Fillion *ARMA/AES Feb 95
* - Extend the use of OBSINCR
* . C. Charette *ARMA/AES Jan 96
* . - TYPVAR obtained from 'compost'
* . P. Gauthier *ARMA/AES Dec. 96
* . - Vorticity, divergence, Psi and Chi are all added to the standard
* . output file of the 3Dvar
* . S. Pellerin *ARMA/AES Sept 97.
* - Control of the different model state of the 3Dvar
* through COMSTATE, COMSTATEC and COMSTNUM common
* blocks variables (comstate.cdk).
* . S. Pellerin *ARMA/AES Oct 97
* - Modification in GDOUT parameters.
* . L. Fillion *ARMA/AES 16 nov 98
* - Postprocessing GZ, ES when cvcord='ETAGE'
* . L. Fillion *ARMA/AES 4 dec 98
* - Postprocessing balanced & unbalanced fields TT,ps,GZ
* . C. Charette *ARMA/AES 08 dec 98
* - Postprocessing HU on analysis grid when cvcord='ETAGE'
* . C. Charette *ARMA/AES mar 2000
* - Change calculation of del(HU) from linear
* tangent approximation (del(HU)=del(LQ)*HUg)
* to full expression based on
* LQa = del(LQ) + LQg
* C. Charette - ARMA/SMC - Sep. 2004
* - Conversion to hybrid vertical coordinate
*
*Arguments
* i- KULOUT : unit used for output
* .
* i- CDPPTYP : type of post-processing
* .
* . 'STAT' Model state contained in COMSP
* . 'GRID' Grid-point fields contained in COMGD
* .
* . 'XMXG' Total analysis increment
* . (COMSP - COMSPG)
* . 'XMXK' Analysis increment with respect to
* . a given reference state kept on file
* . (Current model state is assumed to be in
* . COMSP)
* i- CDETIKET: label used for identification in the RPN standard
* . file (exactly 8 characters, otherwise, it bombs)
*
#endif
C
IMPLICIT NONE
#include "pardim.cdk"
#include "comdim.cdk"
#include "comlun.cdk"
#include "comct0.cdk"
#include "comcva.cdk"
#include "comgd0.cdk"
#include "compost.cdk"
#include "comsp.cdk"
#include "comspg.cdk"
#include "comstate.cdk"
C
INTEGER KULOUT, KITER
CHARACTER*4 CDPPTYP
CHARACTER*8 CDETIKET
C
CHARACTER*1 CLTYPVAR
INTEGER JLEV, JI, JJ, JK, JLA, ILEV,ILEN, JLAT, ILON, JLON, IERR
REAL*8 ZRA2, ZCORIOLIS, ZLOWBOUND,ZHIGHBOUND, ZTEMP
LOGICAL LSTAGTEMP
#include "localpost.cdk"
C
LVARDIAG=.FALSE.
C 0. Allocate local arrays and initialize to zero
C (ONLY IF NOT IN GENINCR BRANCH - ALREADY ALLOCATED)
IF(NCONF.NE.800.AND.NCONF.NE.801) THEN
ILEN = NI*NFLEV*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(PXQR,MAX(1,ILEN),IERR,8)
CALL HPALLOC(PXDD,MAX(1,ILEN),IERR,8)
CALL HPALLOC(PXUUG,MAX(1,ILEN),IERR,8)
CALL HPALLOC(PXVVG,MAX(1,ILEN),IERR,8)
CALL HPALLOC(PXTTG,MAX(1,ILEN),IERR,8)
CALL HPALLOC(PXTTB,MAX(1,ILEN),IERR,8)
CALL HPALLOC(PXTTU,MAX(1,ILEN),IERR,8)
CALL HPALLOC(PXTV,MAX(1,ILEN),IERR,8)
CALL HPALLOC(PXGZ,MAX(1,ILEN),IERR,8)
CALL HPALLOC(PXGZG,MAX(1,ILEN),IERR,8)
CALL HPALLOC(PXGZB,MAX(1,ILEN),IERR,8)
CALL HPALLOC(PXGZU,MAX(1,ILEN),IERR,8)
CALL HPALLOC(PXES,MAX(1,ILEN),IERR,8)
CALL HPALLOC(PXESG,MAX(1,ILEN),IERR,8)
CALL HPALLOC(PXHU,MAX(1,ILEN),IERR,8)
CALL HPALLOC(PXHUG,MAX(1,ILEN),IERR,8)
CALL HPALLOC(PXO3,MAX(1,NI*NJ),IERR,8)
CALL HPALLOC(PXPSG,MAX(1,NI*NJ),IERR,8)
CALL HPALLOC(PXPSB,MAX(1,NI*NJ),IERR,8)
CALL HPALLOC(PXPSU,MAX(1,NI*NJ),IERR,8)
CALL HPALLOC(PXPT,MAX(1,NI*NJ),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,ZUUG(1,1,1))
CALL ZERO(ILEN,ZVVG(1,1,1))
CALL ZERO(ILEN,ZTTG(1,1,1))
CALL ZERO(ILEN,ZTTB(1,1,1))
CALL ZERO(ILEN,ZTTU(1,1,1))
CALL ZERO(ILEN,ZTV(1,1,1))
CALL ZERO(ILEN,ZGZ(1,1,1))
CALL ZERO(ILEN,ZGZG(1,1,1))
CALL ZERO(ILEN,ZGZB(1,1,1))
CALL ZERO(ILEN,ZGZU(1,1,1))
CALL ZERO(ILEN,ZES(1,1,1))
CALL ZERO(ILEN,ZESG(1,1,1))
CALL ZERO(ILEN,ZHU(1,1,1))
CALL ZERO(ILEN,ZHUG(1,1,1))
CALL ZERO(NI*NJ,ZO3(1,1))
CALL ZERO(NI*NJ,zpsg(1,1))
CALL ZERO(NI*NJ,zpsb(1,1))
CALL ZERO(NI*NJ,zpsu(1,1))
CALL ZERO(NI*NJ,zpt(1,1))
ENDIF
C
C 0.1 Identification of the type of processing
C
IF(CDPPTYP.EQ.'STAT') THEN
WRITE(NULOUT,FMT='(/,1X,A,"of the model state ")') 'POSTPROC- Postprocessing '
ELSE IF(CDPPTYP.EQ.'XMXG') THEN
WRITE(NULOUT,FMT='(/,1X,A,"of the analysis increment (X -Xb)")') 'POSTPROC- Postprocessing '
ELSE IF(CDPPTYP.EQ.'XMXK')THEN
WRITE(NULOUT,FMT='(/,1X,A,"of (X -Xk)")')'POSTPROC- Postprocessing '
ELSE IF(CDPPTYP.EQ.'GRID')THEN
WRITE(NULOUT,FMT='(/,1X,A,"of the content of COMGD0 as is")')'POSTPROC- Postprocessing '
END IF
C
C
C* 1. Adapt the spectral state according to what is needed
C
100 CONTINUE
C
C . 1.1 Ouput of the model state
C
110 CONTINUE
IF(CDPPTYP.EQ.'STAT') THEN
IF(NCNTVAR.EQ.2) THEN
WRITE(NULOUT,*)' SPA2SP: Transform analysis variables to'
S ,' model variables -'
if(nanalvar.eq.4) then
LSTAGTEMP=LSTAGWINDS
LSTAGWINDS=.FALSE.
CALL SPA2GD
LSTAGWINDS=LSTAGTEMP
else
CALL SPA2SP
endif
DO JK = 1, NKSDIM
DO JLA = 1, NLA
SP(JLA,1,JK) = SP(JLA,1,JK) + SPG(JLA,1,JK)
SP(JLA,2,JK) = SP(JLA,2,JK) + SPG(JLA,2,JK)
END DO
END DO
END IF
END IF
C
C* . 1.2. Output the analysis increment
C . ----------------------------
C
120 CONTINUE
IF(CDPPTYP.EQ.'XMXG') THEN
IF(NCNTVAR.EQ.1) THEN
DO JK = 1, NKSDIM
DO JLA = 1, NLA
SP(JLA,1,JK) = SP(JLA,1,JK) - SPG(JLA,1,JK)
SP(JLA,2,JK) = SP(JLA,2,JK) - SPG(JLA,2,JK)
END DO
END DO
ELSE IF(NCNTVAR.EQ.2) THEN
WRITE(NULOUT,*)' SPA2SP: Transform analysis variables to'
S ,' model variables -'
if(nanalvar.eq.4) then
LSTAGTEMP=LSTAGWINDS
LSTAGWINDS=.FALSE.
CALL SPA2GD
LSTAGWINDS=LSTAGTEMP
else
CALL SPA2SP
endif
END IF
END IF
C
C* . . 1.3 Output the analysis increment w.r.t. a given reference state
C . ------------------------------------------------------------
C
130 CONTINUE
IF(CDPPTYP.EQ.'XMXK') THEN
WRITE(NULOUT,*)" OPTION XMXK is not yet implemented "
END IF
IF(CDPPTYP.EQ.'GRID') THEN
WRITE(NULOUT,*)" Transferring the content of COMGD0 "
S ,"directly to STD_FILE"
END IF
C
C 2. Passage from spectral to physical space
C
200 CONTINUE
IF(( CDPPTYP.EQ.'STAT')
S .OR.(CDPPTYP.EQ.'XMXK')
S .OR.(CDPPTYP.EQ.'XMXG')) THEN
C
C . 2.1 All model variables as they are
C
if(nanalvar.ne.4) CALL SPGD
C
c Get first guess fields on analysis grid
C Compute increments of HU on analysis grid
c This field is compulsary because it is used
c to produce the analysis of HU in FELIX
c
call getfstg2(zttg,zgzg,zhug,zuug,zvvg,zesg,zpsg,zpt)
IF ( CHUM .EQ. 'LQ' .AND. CVARPOST .NE. 'G') THEN
c *** HU *** (q = qg * lnq)
do jk = 1,nflev
do jj = 1,nj
do ji = 1,ni
ZTEMP = log(zhug(ji,jk,jj)) + q0(ji,jk,jj)
zhu(ji,jk,jj) = EXP(ZTEMP) - zhug(ji,jk,jj)
enddo
enddo
enddo
ENDIF
IF ( CHUM .EQ. 'ES') THEN
call mhuaesgd(zesg,zhug,zttg,zpsg,zpt,ni,nj,nflev)
call lesahugd(zhu,zttg,zhug,zesg,zpsg,zpt,ni,nj,nflev)
ENDIF
C
C . 2.2 Compute diagnostics (INPUT: COMSP --- > LOCALPOST)
C
220 CONTINUE
c
CALL DIAG3DVAR
C
C . 2.3 Impose a constraint that the humidity analysis be within
C . some preset bounds
C
230 CONTINUE
IF(CDPPTYP.EQ.'STAT') THEN
IF(NGEXIST(NGQ) .EQ. 1) THEN
ZLOWBOUND = 0.
ZHIGHBOUND = 30.
CALL TRIMES(ZLOWBOUND,ZHIGHBOUND)
ENDIF
C
IF(NGEXIST(NGOZ) .EQ. 1) THEN
C
C . Clip lower bound of ozone concentration to 0.
C
ZLOWBOUND = 0.
CALL TRIMEGDX(NGPOSIT(NGOZ),'>',ZLOWBOUND,ZHIGHBOUND,
$ NFLEV)
ENDIF
ENDIF
END IF
C
C* 3. Output grid-point fields to a RPN standard file (including diagnostic fields)
C . -----------------------------------------------------------------------------
C
300 CONTINUE
C
CLTYPVAR = CVARPOST
C
DO JLEV = 1, NFLEV
IF(NPPLEV(JLEV).EQ.1) THEN
CALL GDOUT(KULOUT,JLEV,KITER,CDETIKET,CLTYPVAR,NSTAMP)
END IF
END DO
C
C* 4. Diagnostics of the analysis increments (simulated obs. only)
C N.B. this section does not alter the content of COMGD
C . -------------------------------------------------------------
C
400 CONTINUE
IF(CDPPTYP.EQ.'XMXG'.AND.LSIMOB) THEN
CALL OBSINCR(KULOUT)
END IF
C
C
C 9. Deallocate local arrays
C
900 CONTINUE
C
IF(NCONF.NE.800.AND.NCONF.NE.801) THEN
CALL HPDEALLC(PXPP,IERR,1)
CALL HPDEALLC(PXQQ,IERR,1)
CALL HPDEALLC(PXQR,IERR,1)
CALL HPDEALLC(PXCC,IERR,1)
CALL HPDEALLC(PXDD,IERR,1)
CALL HPDEALLC(PXUUG,IERR,1)
CALL HPDEALLC(PXVVG,IERR,1)
CALL HPDEALLC(PXTTG,IERR,1)
CALL HPDEALLC(PXTTB,IERR,1)
CALL HPDEALLC(PXTTU,IERR,1)
CALL HPDEALLC(PXTV,IERR,1)
CALL HPDEALLC(PXGZ,IERR,1)
CALL HPDEALLC(PXGZB,IERR,1)
CALL HPDEALLC(PXGZU,IERR,1)
CALL HPDEALLC(PXES,IERR,1)
CALL HPDEALLC(PXESG,IERR,1)
CALL HPDEALLC(PXHU,IERR,1)
CALL HPDEALLC(PXHUG,IERR,1)
CALL HPDEALLC(PXO3,IERR,1)
CALL HPDEALLC(PXPSG,IERR,1)
CALL HPDEALLC(PXPSB,IERR,1)
CALL HPDEALLC(PXPSU,IERR,1)
CALL HPDEALLC(PXPT,IERR,1)
ENDIF
C
RETURN
END