subroutine postmin 2,13
use mod4dv, only : l4dvar
use modstag, only : lstagwinds
#if defined (DOC)
*
***s/r postmin - Post-minimization control of the 3Dvar
*
*
*Author : S. Pellerin *ARMA/SMC May 2000
*Revision:
* S. Pellerin: fix to spa2sp/spgd call conditions
* C. Charette - ARMA/SMC - Sep. 2004
* - Conversion to hybrid vertical coordinate
* Y. Yang Sep. 2004
* - Added call to ch_varout for outputing species
* Y. Yang Feb. 2005
* - Deleted ZO3 and PXO3
* Bin He *ARMA/SMC Dec. 2006
* - added calling memfree before varout to free some memories
* which are not needed in varout.
* S. Pellerin August 2008
* - Added calls to 'tmg_*' subroutines
* Y. Yang, Aug. 2010
* - Added call to chi_2_test
* -------------------
**
*
*Arguments
* -NONE-
#endif
IMPLICIT NONE
*implicits
#include "pardim.cdk"
#include "comdim.cdk"
#include "comlun.cdk"
#include "comcva.cdk"
#include "comgem.cdk"
#include "comgdpar.cdk"
#include "compost.cdk"
#include "comgd0.cdk"
#include "localpost.cdk"
#include "comoabdy.cdk"
#include "comvarqc.cdk"
#include "comvfiles.cdk"
*
C
INTEGER IZS(1)
REAL*8 ZZS(1)
REAL*8 DLDS(1)
LOGICAL LLTEST
CHARACTER *8 CSTATUS
C
INTEGER IMPRES, IMODE, ITERMAX, ISIMMAX, INDIC, ISCALE
INTEGER IERR,ITERDONE,ITERTOT,JK, JLA,ilen,jj,ji
REAL*8 ZJSP, ZXMIN, ZDF1, ZEPS, ZSMACH,ztemp
REAL*8 DLGNORM, DLXNORM, DLGNORM0, DLGNORMS
C
LOGICAL LSTAGTEMP
INTEGER FNOM,FCLOS
EXTERNAL FNOM,FCLOS
EXTERNAL TESTSP, M1QN2, M1QN3, ABORT3D
S , SCALQN, CANAB, CANONB, PRSCAL , DEMARRE
S , TRANSFER, SUPOST
c
c if a restart file was writen at the end of minimize.ftn,
c lrestart was turn to .true. to avoid postmin execution
c
if (lrestart) return
c
write(nulout,*) 'ENTERING POSTMIN'
C
LVARDIAG=.FALSE.
ILEN = NI*NFLEV*NJ
CALL HPALLOC(PXTTG,MAX(1,ILEN),IERR,8)
CALL HPALLOC(PXHUG,MAX(1,ILEN),IERR,8)
CALL HPALLOC(PXUUG,MAX(1,ILEN),IERR,8)
CALL HPALLOC(PXVVG,MAX(1,ILEN),IERR,8)
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(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(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(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,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,zpsg(1,1))
CALL ZERO(NI*NJ,zpsb(1,1))
CALL ZERO(NI*NJ,zpsu(1,1))
CALL ZERO(NI*NJ,zpt(1,1))
C
C Copy REAL*8 part of CMA back to REAL*4 CMA counterpart
C after minimization has ended. From this point all CMA
C references are to ROBDATA.
call cprob8to4
C
IF (LVARQC) CALL LISTREJ
C
CALL VINT3DFD(NCMOMA)
CALL VINT3DFD(NCMOMF)
CALL SETASSFLG
CALL FILBRPPOST
c
CALL SUPOST
c
NIP2 = NIP2A
NIG2 = NIG2A
NDEET = NDEETA
NPAS = NPASA
NSTAMP= NSTAMPA
CVARPOST = 'R'
c
WRITE(NULOUT,FMT='(/," POSTMIN - Postprocessing")')
WRITE(NULOUT,FMT='(11X,"of the analysis increment (X -Xb)")')
C
C In l4dvar mode transform of variables has already been done in ENDSIM2
C at the end of minimize
C
if(.not. l4dvar .or. .not. ltlmend) then
call tmg_start(51,'VAR_CH') !
CALL CAIN(NVADIM,VAZX)
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
call spgd
endif
call tmg_stop (51) !
endif
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 getfstg(zttg,zhug,zuug,zvvg,zesg,zpsg,zpt,ni,nj,nflev)
c
IF ( CHUM .EQ. 'LQ') THEN
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
call diag3dvar
c
c Free these memory which are not needed in varout
c
CALL memfree(nulout)
call tmg_start(99,'VAROUT')
CALL varout
CALL ch_varout
call tmg_stop(99)
C
C chi^2 test
C
call chi_2_test
C
CALL HPDEALLC(PXTTG,IERR,1)
CALL HPDEALLC(PXHUG,IERR,1)
CALL HPDEALLC(PXUUG,IERR,1)
CALL HPDEALLC(PXVVG,IERR,1)
CALL HPDEALLC(PXPP,IERR,1)
CALL HPDEALLC(PXQQ,IERR,1)
CALL HPDEALLC(PXCC,IERR,1)
CALL HPDEALLC(PXQR,IERR,1)
CALL HPDEALLC(PXDD,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(PXPSG,IERR,1)
CALL HPDEALLC(PXPSB,IERR,1)
CALL HPDEALLC(PXPSU,IERR,1)
CALL HPDEALLC(PXPT,IERR,1)
C
write(nulout,*) 'LEAVING POSTMIN'
C
RETURN
END