!-------------------------------------- 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 RANDOBS 1,7
#if defined (DOC)
*
***s/r RANDOBS - Multiply random observations by R^1/2
* Based on OBSCORUA
*
* ONLY HUMSAT AND SATEM HAVE VERT CORRELATIONS???
*
*Author : M. Buehner *CMC/AES February 2000
*Revision:
* 1/2
** Purpose: - CALCULATE [O] * RAND
*
*Arguments
*
#endif
IMPLICIT NONE
*implicits
#include "comlun.cdk"
#include "comcst.cdk"
#include "comdimo.cdk"
#include "comdim.cdk"
#include "comoabdy.cdk"
#include "comoahdr.cdk"
#include "comoba.cdk"
#include "cvcord.cdk"
#include "comstato.cdk"
#include "comvcor.cdk"
#include "comstate.cdk"
#include "comfilt.cdk"
#include "comcva.cdk"
#include "comstato2.cdk"
*
REAL*8 GASDEV
INTEGER IBEGIN,ILAST,IDATA,IK,IBEGINOBS,INOBS,IOBS,ILASTOBS
INTEGER IERR, IELMGZ, IELMDZ, ILYR, ILEN
INTEGER J,JDATA,JL,JVAR,jpos, INONZERO
REAL*8 XTEMP(JPMAXILEV,JPNMAXPRO), RESULT(JPMAXILEV,JPNMAXPRO)
REAL*8 ZRNDMEAN,ZRNDSTD
LOGICAL LLOK
C
INTEGER IUU , IVV , IGZ , IDZ ,ITT , IES
DATA IUU,IVV,IGZ,IDZ,ITT,IES/11003,11004,10194,10192,12001,12192/
EXTERNAL GASDEV
C
C===============
IELMGZ = 10194
IELMDZ = 10192
C===============
C
C LOOP OVER ALL FILES AND LOOK FOR THE ONES
c CONTAINING HUMSAT, SATEM? or RAOBS
C
WRITE(NULOUT,*) ' STARTING RANDOBS '
DO J = 1,NFILES
C -----------HUMSAT--------------
IF ( CFAMTYP(J) .EQ. 'HU') THEN
WRITE(NULOUT,*) ' STARTING HUMSAT: ',CFAMTYP(J)
IBEGIN=NBEGINTYP(J)
ILAST =NENDTYP(J)
IBEGINOBS=MOBDATA(NCMOBS,IBEGIN)
ILASTOBS =MOBDATA(NCMOBS,ILAST)
ILEN =ILASTOBS-IBEGINOBS +1
C
DO JVAR=1,nelems
IK=0
CALL ZERO(JPMAXILEV*JPNMAXPRO,XTEMP)
DO JDATA = IBEGIN, ILAST
c LLOK=
c & (MOBDATA(NCMASS,JDATA) .EQ. 1)
c & .AND. (MOBDATA(NCMXTR,JDATA) .EQ. 0)
c & .AND. (MOBDATA(NCMVNM,JDATA) .EQ. nlist(jvar))
LLOK=(MOBDATA(NCMVNM,JDATA) .EQ. nlist(jvar))
IF ( LLOK ) THEN
IK=IK+1
NINDX(IK) = JDATA
ILYR = MOBDATA(NCMLOBS,JDATA)
IOBS = MOBDATA(NCMOBS,JDATA)
INOBS = IOBS-IBEGINOBS + 1
XTEMP(ILYR,INOBS) = GASDEV(1)
ENDIF
END DO
C
IF (IK .GT. 0 ) THEN
C
write(NULOUT,*) 'RANDOBS: humsat obs processed:',IK
IF (nlist(jvar) .EQ. ies) THEN
CALL MXMAOP(HUOBSCOR2,1,JPMAXILEV, XTEMP,1,JPMAXILEV,
& RESULT,1,JPMAXILEV,JPHLEV,JPHLEV,ILEN)
ENDIF
C
C Add random perturbation to CMA
C
DO JDATA = 1, IK
IDATA = NINDX(JDATA)
ILYR = MOBDATA(NCMLOBS,IDATA)
IOBS = MOBDATA(NCMOBS,IDATA)
INOBS = IOBS-IBEGINOBS + 1
ROBDATA8(NCMVAR,IDATA) = ROBDATA8(NCMVAR,IDATA) +
+ RESULT(ILYR,INOBS)*ROBDATA8(NCMOER,IDATA)
END DO
C
ENDIF
C
enddo
C
C -----------SATEM--------------
ELSEIF ( CFAMTYP(J) .EQ. 'ST') THEN
WRITE(NULOUT,*) ' STARTING SATEM: ',CFAMTYP(J)
IBEGIN=NBEGINTYP(J)
ILAST =NENDTYP(J)
IBEGINOBS=MOBDATA(NCMOBS,IBEGIN)
ILASTOBS =MOBDATA(NCMOBS,ILAST)
ILEN =ILASTOBS-IBEGINOBS +1
C
C LOOP OVER VARIABLE TYPES ( 0=U 1=V 2=GZ 3=T-Td ...)
C
DO JVAR=1,nelems
DO JL=1,JPNTYP
C
C JL=1:CLEAR 2 : CLOUDY
C
IK=0
CALL ZERO(JPMAXILEV*JPNMAXPRO,XTEMP)
DO JDATA = IBEGIN, ILAST
c LLOK= ((MOBDATA(NCMOEC,JDATA) .EQ. JL )
c & .AND. (MOBDATA(NCMASS,JDATA) .EQ. 1)
c & .AND. (MOBDATA(NCMXTR,JDATA) .EQ. 0)
c & .AND. (MOBDATA(NCMVNM,JDATA) .EQ. nlist(jvar)))
c & .OR. ((MOBDATA(NCMOEC,JDATA) .EQ. JL)
c & .AND.(MOBDATA(NCMASS,JDATA) .EQ. 1)
c & .AND.(MOBDATA(NCMXTR,JDATA) .EQ. 2)
c & .AND.(MOBDATA(NCMVNM,JDATA) .EQ. nlist(jvar))
c & .AND.(MOBDATA(NCMVNM,JDATA) .EQ. IELMDZ))
LLOK= ( (MOBDATA(NCMOEC,JDATA).EQ.JL)
& .AND.(MOBDATA(NCMVNM,JDATA).EQ.nlist(jvar)) )
IF ( LLOK ) THEN
IK=IK+1
NINDX(IK) = JDATA
ILYR = MOBDATA(NCMLOBS,JDATA)
IOBS = MOBDATA(NCMOBS,JDATA)
INOBS = IOBS-IBEGINOBS + 1
XTEMP(ILYR,INOBS) = GASDEV(1)
ENDIF
END DO
C
IF ( IK .NE. 0 ) THEN
C
write(NULOUT,*) 'RANDOBS: satem obs processed:',IK
IF (nlist(jvar) .EQ. idz) THEN
CALL MXMAOP(DZOBSCOR2(1,1,JL),1,JPMAXILEV, XTEMP,1,JPMAXILEV,
& RESULT,1,JPMAXILEV,JPSALEV,JPSALEV,ILEN)
ENDIF
C
C Add Random Perturbation to CMA
C
DO JDATA = 1, IK
IDATA = NINDX(JDATA)
ILYR = MOBDATA(NCMLOBS,IDATA)
IOBS = MOBDATA(NCMOBS,IDATA)
INOBS = IOBS-IBEGINOBS + 1
ROBDATA8(NCMVAR,IDATA) = ROBDATA8(NCMVAR,IDATA) +
+ RESULT(ILYR,INOBS)*ROBDATA8(NCMOER,IDATA)
END DO
C
ELSE
WRITE(NULOUT,*) ' NO SATEMS WITH TYPE: ',JL
ENDIF
C
END DO
enddo
C
C -----------OTHER TYPES (NO VERTICAL CORRELATIONS)--------------
ELSE
C
C Other types: just add random variable multiplied by Sigma_obs
C
WRITE(NULOUT,*) ' STARTING OTHER TYPE: ',CFAMTYP(J)
IF(NBEGINTYP(J) .GT. 0) THEN
IBEGIN=NBEGINTYP(J)
ILAST =NENDTYP(J)
DO JDATA = IBEGIN, ILAST
ROBDATA8(NCMVAR,JDATA) = ROBDATA8(NCMVAR,JDATA) +
+ GASDEV(1)*ROBDATA8(NCMOER,JDATA)
END DO
ENDIF
C
ENDIF
END DO
WRITE(NULOUT,*)'-END----------RANDOBS------------------END-'
RETURN
END