SUBROUTINE CNT0,21
#if defined (DOC)
*
*** s/r CNT0 - Routine controlling the job at its highest level
*
* Author : P. Gauthier *ARMA/AES June 9, 1992
* Revision:
* P. Koclas CMC/CMSV January 1997
* . added calls to EXDB and SUFILNAM
* M. Buehner October 1998
* configs for stats computation
*
* M. Buehner january 1999
* Added options for hbht and 1obs experiments
* S. Pellerin *ARMA/SMC April 2000
* .Clean up
* .Introduction of NCONF 141:
* -> Horizontal and Vertical interpolations
* of trial to Obs location and analysis
* levels
* -> Horizontal and vertical interpolations
* of increments to model grid points and levels
* -> Truncation and vertical interpolation of
* Background statistics
*
* C. Charette M.Buehner *ARMA/SMC Jun 2002
* .To calculate variance of observed variables with v9.2.0(CALL HBHT)
* .TO do single obs experiment with direct calculation
* for observed variables with v9.2.0(CALL ONEOBS)
* Note: These 2 options were no longer working with version
* 9 of the 3dvar
*
* M. Buehner August 2002
* .Added options related to HEV's (preconditioning) and SV's
* C. Charette M.Buehner *ARMA/SMC Nov 2004
* .Remove temporary reset of nconf to 141 for case(901)
*
* Y. Yang AQRB JUNE 2005
* .Added option 888 to do splitting analysis for unobserved variables
*
* M. Buehner May 2008
* .Added option 801 - version of genincr when using new approach
* for PtoT with localized Tb correlations (NANALVAR=4)
*
* S. Pellerin August 2008
* .Added calls to 'tmg_*' subroutines
*
* Y.J. Rochon Nov 2008
* .Added note for alternatives to case=400 for simulating obs.
*
**
* Arguments
* -NONE-
*
#endif
IMPLICIT NONE
* implicits
#include "comct0.cdk"
#include "comlun.cdk"
*
INTEGER ICONFI,ISTAMP,EXDB,EXFIN
character(len=9) :: clmsg
call tmg_init (0, 'TMG_3D-VAR' )
clmsg = 'VAR3D_BEG'
call wrstatus(clmsg)
ISTAMP=EXDB('3DVAR','DEBUT','NON')
C
C
C * 1. Initialize level 0 commons.
C ---------------------------
C
100 CONTINUE
CALL SU0YOMA
C
C
call printrev("START OF MAIN PROGRAM CNT0",26)
C
C
CALL SU0YOMB
C ------------------------------------------------------------------
C
C * 2. Decide on configuration of job.
C -------------------------------
C
200 CONTINUE
ICONFI=IABS(NCONF)/100
C
C * 2.0 INTEGRATION JOB: barotropic model configuration.
C
201 CONTINUE
select case (nconf)
case(101)
WRITE(NULOUT,FMT=9203)ICONFI,NCONF
9203 FORMAT(" CNT0- NCONF = ",1X,I4," CALLING BGCHECK")
call tmg_start(11,'PREMIN')
call preproc
call tmg_stop(11)
call tmg_start(12,'BGCHECK')
CALL BGCHECK
call tmg_stop(12)
case(121)
WRITE(NULOUT,FMT=9204)ICONFI,NCONF
9204 FORMAT(" CNT0- ICONFI NCONF = ",1X,I4,1X,I4," CALLING RESIDUAL
& S")
call tmg_start(11,'PREMIN')
call preproc
call tmg_stop(11)
call tmg_start(12,'RESIDUALS')
CALL RESIDUALS
call tmg_stop (12)
case(131)
WRITE(NULOUT,FMT=9900)NCONF
call su1obs
call hbht
9900 FORMAT(//,40(" *"),/,4X,"NCONF =",1X,I3,4X
S ," -HBHT- computation of effective standard deviations "
S ," for observed variables -",/,40(" *"),/)
case(141)
WRITE(NULOUT,FMT=9401)NCONF
9401 FORMAT(" CNT0- NCONF = ",1X,I4," CALLING PREPROC")
call tmg_start(11,'PREMIN')
call preproc
call tmg_stop (11)
call tmg_start(12,'MIN')
call minimize
call tmg_stop (12)
call tmg_start(13,'POSMIN')
call postmin
call tmg_stop (13)
c
case(300)
WRITE(NULOUT,FMT=9300)NCONF
9300 FORMAT(//,40(" *"),/,4X,"NCONF =",1X,I3,4X
S ,"- STATISTICAL ESTIMATION OF THE FORECAST ERROR"
S ," CORRELATIONS -",/,40(" *"),/)
c
CALL CSE1
case(400)
c
c To produce output BURP files with simulated obs based on locations and
c characteristics consistent with real+dummy obs in input BURP files,
c use case=101,121, or 141 with LSIMOB=.TRUE. instead of case=400. (yjr)
c
CALL CSIMOBS1
case(500)
c
WRITE(NULOUT,*) '-----------------------------'
WRITE(NULOUT,*) 'ESTIMATION OF P_TO_T OPERATOR'
WRITE(NULOUT,*) '-----------------------------'
CALL PTOT1
case(600)
WRITE(NULOUT,FMT=9402)NCONF
9402 FORMAT(" CNT0- NCONF = ",1X,I4," CALCULATING HEVs")
call tmg_start(11,'PREMIN')
call preproc
call tmg_stop(11)
call calchev
case(601)
WRITE(NULOUT,FMT=9403)NCONF
9403 FORMAT(" CNT0- NCONF = ",1X,I4," CALCULATING SVs")
call tmg_start(11,'PREMIN')
call preproc
call tmg_stop(11)
call calcsv
case(605)
WRITE(NULOUT,FMT=9404)NCONF
9404 FORMAT(" CNT0- NCONF = ",1X,I4," PARTIALLY EVOLVE SVs")
call tmg_start(11,'PREMIN')
call preproc
call tmg_stop(11)
call propsv
case(610)
WRITE(NULOUT,FMT=9405)NCONF
9405 FORMAT(" CNT0- NCONF = ",1X,I4," 1OBS WITH SVs")
call su1obs
call susvbg
call oneobs
c
case(611)
WRITE(NULOUT,FMT=9406)NCONF
9406 FORMAT(" CNT0- NCONF = ",1X,I4," MINIMIZE WITH SVs")
call susvbg
call tmg_start(11,'PREMIN')
call preproc
call tmg_stop(11)
call tmg_start(12,'MIN')
call minimize
call tmg_stop (12)
call tmg_start(13,'POSMIN')
call postmin
call tmg_stop (13)
c
case(800)
WRITE(NULOUT,FMT=9800)NCONF
CALL GENINCR
9800 FORMAT(//,40(" *"),/,4X,"NCONF =",1X,I3,4X
S ," -GENINCR- COMPUTATION OF FORECAST DIFFERENCES FOR THE"
S ," ANALYSIS VARIABLES -",/,40(" *"),/)
C
case(801)
WRITE(NULOUT,FMT=9801)NCONF
CALL GENINCR_2
9801 FORMAT(//,40(" *"),/,4X,"NCONF =",1X,I3,4X
S ," -GENINCR- COMPUTATION OF FORECAST DIFFERENCES FOR THE"
S ," ANALYSIS VARIABLES (NEW PTOT APPROACH) -",/,40(" *"),/)
C
case(888)
WRITE(NULOUT,FMT=9888)NCONF
C
C call tmg_start(14,'SPLITTING')
CALL ch_susplit(0)
call tmg_stop(14)
C
9888 FORMAT(//,40(" *"),/,4X,"NCONF =",1X,I3,4X
S ," -CH_SUSPLIT- SPLITTING ANALYSIS ALGORITHM"
S ,/,40(" *"),/)
C
case(901)
WRITE(NULOUT,FMT=9990)NCONF
call su1obs
IF(LCHEM) THEN
C
C with chemistry species assimilation
C
call ch_oneobs
ELSE
C
C without chemistry species assimilation
C
call oneobs
ENDIF
9990 FORMAT(//,40(" *"),/,4X,"NCONF =",1X,I3,4X
S ," -ONEOBS- single obs experiment with direct calculation
& "," for observed variables -",/,40(" *"),/)
c
case(3211)
write(nulout,fmt='(//,4x,A,1x,i4)')'Testing spectral transforms...NCONF =',nconf
call teststagwinds
case default
WRITE(UNIT=NULOUT,FMT='('' ERROR CNT0 JOB'',2I6)')ICONFI,NCONF
END select
C
C * 3. Job termination
C
300 CONTINUE
C
CALL SUTERM(NULOUT)
C
clmsg = 'VAR3D_END'
call wrstatus(clmsg)
call tmg_terminate (0, 'TMG_3D-VAR' )
RETURN
END