!-------------------------------------- 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 set1lev 2,3
#if defined (DOC)
*
***s/r set1lev - Set analysis Level "mk" for 1-Obs and/or Shallow-Water 3dvar.
*
*
*Author : L. Fillion - ARMA/EC - 18 Mar 2008.
*Revision:
*
** Purpose:
*
*
*Arguments
* none
#endif
IMPLICIT NONE
*implicits
#include "taglam4d.cdk"
#include "comlun.cdk"
#include "comct0.cdk"
#include "comcva.cdk"
#include "pardim.cdk"
#include "comdim.cdk"
#include "comdimo.cdk"
#include "commvo.cdk"
#include "comgem.cdk"
#include "comsim.cdk"
#include "com1obs.cdk"
#include "comfilt.cdk"
*
*
INTEGER ik,jlev
REAL*8 zppobs
REAL*8 zdiff,zmin,zcon
LOGICAL LLPRINT
!
!!
LLPRINT = .true.
!
!*1. Determine analysis Level which is closest to NONELEV defined in namelist namfilt
! --------------------------------------------------------------------------------
!
if(lsw) then
if(l1obs) then ! forced single Obs (e.g. for intercomparison project with other center's response)
zppobs = R1OBSLV*1.e2 ! (Pa)
zcon = zppobs/1.e3
if(zcon.le.0.or.zcon.gt.1100.) then
call abort3d
(nulout,'set1lev: namelist value R1OBSLV irrealistic!')
endif
else
zcon = nonelev/1.e3
if(zcon.le.0.or.zcon.gt.1100.) then
call abort3d
(nulout,'set1lev: Check your NAMFILT: NONELEV value irrealistic!')
endif
zppobs = real(nonelev) ! (Pa)
endif
else if(l1obs) then
zppobs = R1OBSLV*1.e2 ! (Pa)
zcon = zppobs/1.e3
if(zcon.le.0.or.zcon.gt.1100.) then
call abort3d
(nulout,'set1lev: namelist value R1OBSLV irrealistic!')
endif
endif
!
zmin = 1.e32
ik = vlev(nflev)
do jlev = 1, nflev
zdiff = abs(rppobs(jlev,1)-zppobs)
if(zdiff.lt.zmin) then
zmin = zdiff
ik = jlev
endif
enddo
mk = ik ! will be kept in comsim.cdk
write(nulout,*) 'SET1LEV: '
write(nulout,*) '****************************************'
write(nulout,*) 'SET1LEV: : MODEL LEVEL USED = ',VLEV(MK)
write(nulout,*) '****************************************'
write(nulout,*) 'SET1LEV: '
!
if(lsw.and..not.l1obs) then
if(llprint) write(nulout,*) 'set1lev: nonelev (Pa) = ',nonelev
else
if(llprint) write(nulout,*) 'set1lev: R1OBSLV (hPa) = ',R1OBSLV
endif
if(llprint) write(nulout,*) 'set1lev: Obs. Level mk = ',mk
!
RETURN
END