SUBROUTINE SU1OBS 3,6
use mod4dv, only : l4dvar
#if defined (DOC)
*
***s/r SU1OBS - Set-up for single obs experiments and to print diagnostics
* at the analysis grip point nearest to the desired lat-lon
* position.
*
*
*Author : C. Charette *ARMA/AES November 1998
*Revision:
* P. KOCLAS CMC October 1999
* Z1OBSLA Real*8 ( for call to isrchila on pollux)
* P. Gauthier *ARMA/MSC March 2003
* - Generalization to include the (N+1) obs.
* experiment
* C. Charette - ARMA/SMC - Sep. 2004
* - Added variable LVLNEAR
* Y. Yang Jan. 2004
* - Added new variables ICORDTYP, R1OBSPTOP, and R1OBSPBTM for
* new vertical coordinates
* Y.J. Rochon *ARQX/MSC May 2005
* - Changed RO1OBSPBTM from -999 to 1200.0mb to imply surface
* Y.J. Rochon ARQX, March 2010
* - Added calls to ch_tunebgcoef and ch_tuneobs
*
* -------------------
** Purpose:
* - Set-up for single obs experiments and to print diagnostics
* at the analysis grip point nearest to the desired lat-lon
* position. Single obs experiments are initialized by setting
* the variable LONEOBS = .TRUE. and NCONF=901 in the namelist.
* Diagnostics at the analysis grid point nearest to the desired
* lat-lon can be obtained at any time during the execution. It
* controlled by the variable LLPRINT in the routines involved.
*
* .
#endif
IMPLICIT NONE
*implicits
#include "comdim.cdk"
#include "comcst.cdk"
#include "comlun.cdk"
#include "comct0.cdk"
#include "comleg.cdk"
#include "com1obs.cdk"
#include "comcva.cdk"
#include "cominterp.cdk"
#include "comvfiles.cdk"
#include "comchem.cdk"
*
include 'prof_f.h'
c
INTEGER IERR,ISRCHILA,IHDL,ISTAT,prof_wrrec
REAL*8 Z1OBSLA
REAL*8 ZLAT1,ZLAT2,zlonrad
character (len=128) :: clprof
c
c Initialization of interpolation parameters
c
write(nulout,fmt='(//,4x,A)')'SU1OBS- Set-up for single obs experiments'
lvintbgstat = .false.
lhintdelhu = .true.
c
call readnml('NAMINTERP',IERR)
WRITE(NULOUT,'(3X,"- reading the namelist NAMCVA in ONEOBS")')
CALL READNML('NAMCVA',IERR)
C
C Set up stats, and other things (some unnecessary)
C
if(nconf.ne.141) then
call sucva(nulout)
end if
c
c Read in scaling factors to adjust obs error std dev in cma
c and background error std. dev. scaling factor
c
if(ntunestats.eq.5) then
call rdtunebgobs
endif
C
if (LCHEM) then
C
C Set background error std. dev. scaling factors for constituents
C
if (ntunetrbg.eq.5) call ch_tunebgcoef
C
C Tune the TR observation error statistics
C
if (ntunetrobs.eq.5) call ch_tuneobs
C
end if
c
C
C* 1. Default values
C
100 CONTINUE
C
LONEOBS = .FALSE.
LVLNEAR = .TRUE.
R1OBSLA = 50.0
R1OBSLO = 330.0
R1OBSLV = 1020.0
R1OBSINO = 1.0
R1OBSOER = 5.15
C1OBSTP = 'UU'
C1OBSBG = 'FGUESS'
C
ICORDTYP = 1
R1OBSPTOP = 0.0
R1OBSPBTM = 1200.0
C
C * . 1.2 Read the NAMELIST NAM1OBS to modify them
C . ---------------------------------------
120 CONTINUE
WRITE(NULOUT,FMT=9120)
9120 FORMAT(3X,'- reading the namelist NAM1OBS in SU1OBS')
C
CALL READNML('NAM1OBS',IERR)
C
C * . 1.2 Calculate indexes of nearest analysis grid point
C and vertical level
C . ---------------------------------------
C
C Longitude
C
call srchlon(NI1OBSLO,zlonrad,R1OBSLO)
C
C Latitude
C
Z1OBSLA=R1OBSLA*2.0*RPI/360.0
ZLAT1=RLATI(ISRCHILA(Z1OBSLA)+1)
ZLAT2=RLATI(ISRCHILA(Z1OBSLA))
if(abs(ZLAT1-Z1OBSLA).lt.abs(ZLAT2-Z1OBSLA)) then
NI1OBSLA = ISRCHILA(Z1OBSLA)+1
else
NI1OBSLA = ISRCHILA(Z1OBSLA)
endif
C
C * . 1.4 Print the content of this NAMELIST
C
130 CONTINUE
WRITE(NULOUT,FMT=9130)C1OBSTP,C1OBSBG,LONEOBS,LVLNEAR
S ,R1OBSLA,R1OBSLO,R1OBSLV,R1OBSOER,R1OBSINO
S ,NI1OBSLA,NI1OBSLO
9130 FORMAT(8x,'--Parameters used for the single obs experiment'
S ,8x,' or to print diagnostics when applicable'
S ,' (read in NAM1OBS)'
S ,/,4X,'Type of observation (single obs) : ',2X,A2
S ,/,4X,'Type of background field : ',2X,A8
S ,/,4X,'Test to start single obs exp : ',2X,L1
S ,/,4X,'Test to move obs to nearest level: ',2X,L1
S ,/,4X,'Latitude desired (-90 to 90) : ',2X,F6.2
S ,/,4X,'Longitude desired (0 to 360) : ',2X,F6.2
S ,/,4X,'Vertical level desired (mb) : ',2X,F6.2
S ,/,4X,'Std deviation obs error : ',2X,F6.2
S ,/,4X,'Size of the innovation : ',2X,F6.2
S ,/,4X,'Index of grid point nearest to latitude :',2X,i5
S ,/,4X,'Index of grid point nearest to longitude :',2X,i5)
C
WRITE(NULOUT,*)'Index of the nearest eta level to R1OBSLV= '
S ,R1OBSLV
WRITE(NULOUT,*)'WILL BE CALCULATED BY THE ROUTINE ONEOBS '
C
C For 4dvar job only write out number of segments and simulation number in init file
C
IF(L4DVAR) THEN
nsim3d=1
write(nulout,*) 'IN SU1OBS: WRITING INIT.PROF FILE'
clprof = trim(CEXC4DV) // '/init.prof'
ihdl = prof_open(clprof,'WRITE','FILE')
istat = prof_pvar(ihdl,1,prm_stob)
istat = prof_pvar(ihdl,nsim3d,prm_rstr)
istat = prof_wrrec(ihdl)
istat = prof_close(ihdl)
ENDIF
C
C
RETURN
END