!-------------------------------------- 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 randhbht1 1,5
#if defined (DOC)
*
***s/r randhbht1 - output random sample of background error in obs space in posv file
*
*Author : M. Buehner *ARMA/MSC March 2005
*Revision: S. Pellerin ARMA, January 2009
* Call to oda subroutines (sqrtB, L and H)
* -------------------
** Purpose: *
* . *
* . *
* . *
* . *
*
*Arguments
* -NONE-
#endif
IMPLICIT NONE
*implicits
#include "comct0.cdk"
#include "pardim.cdk"
#include "comdim.cdk"
#include "com1obs.cdk"
#include "comlun.cdk"
#include "comgem.cdk"
#include "comdimo.cdk"
#include "commvo.cdk"
#include "commvohr.cdk"
#include "commvog.cdk"
#include "comoabdy.cdk"
#include "comoahdr.cdk"
#include "comoba.cdk"
#include "comvarqc.cdk"
#include "comcva.cdk"
#include "cparbrp.cdk"
#include "cominterp.cdk"
#include "comcst.cdk"
#include "comrand.cdk"
#include "localpost.cdk"
#include "comgdpar.cdk"
#include "rpnstd.cdk"
#include "cvcord.cdk"
#include "comgd0.cdk"
#include "comsp.cdk"
#include "comspg.cdk"
#include "compost.cdk"
#include "comfilt.cdk"
#include "comleg.cdk"
#include "comstato.cdk"
#include "compstat.cdk"
#include "comnumbr.cdk"
c
integer jj,jdata
real*8 gasdev
real*8 zcmaoma(ndata)
real*8 zjoraob,zjoairep,zjosatwind,zjosurfc,zjosfcsf,zjosfcua,zjotov,zjogoes,zjogpsro,zjoprof
logical lexist
external gasdev
c
call printrev
("SUBROUTINE randhbht1 :",22)
c
c initialize random number generator seed
c
inquire(file='randnum.dat',exist=lexist)
if(lexist) then
open(unit=39,form='unformatted',file='randnum.dat')
read(39) (rrand(jj),jj=1,97)
read(39) ix1,ix2,ix3,iff
close(39)
write(nulout,*) 'READING IN RANDNUM'
else
write(nulout,*) 'RANDNUM FILE DOES NOT EXIST'
endif
c
c Save contents of CMA (observed values)
c
do jdata = 1, ndata
zcmaoma(jdata)=robdata8(ncmoma,jdata)
robdata8(ncmoma,jdata)=-888.0
enddo
c
c compute HBHT realization in obs space
c
write(nulout,*) '******************'
write(nulout,*) 'COMPUTING REALIZATION OF BG ERROR IN OBS SPACE'
do jj=1,nvadim
vazx(jj)=gasdev
(1)
enddo
call oda_sqrtB
(vazx,nvadim)
call oda_L
call oda_H
! Compute Hdx and store the results in ncmoma
c
do jdata = 1, ndata
robdata(ncmfge,jdata)=robdata8(ncmoma,jdata)
robdata8(ncmoma,jdata)=zcmaoma(jdata)
enddo
c
c
c set starting point back to zero for minimization
c
do jj=1,nvadim
vazx(jj)=0.0d0
enddo
c writing out random number generator seed
c
open(unit=39,form='unformatted',file='randnum.dat')
write(39) (rrand(jj),jj=1,97)
write(39) ix1,ix2,ix3,iff
close(39)
c
write(nulout,*) 'DONE COMPUTING REALIZATION OF BG ERROR IN OBS SPACE'
write(nulout,*) '******************'
c
return
end