SUBROUTINE RANDOBS 1,1
#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:
* Y.J. Rochon *ARQX Nov 2010
* - Apply std. dev. scaling factor dependent on
* CFAMTYP and occasionally MOBDATA(NCMVNM,*)
*
* For comparison, values
* following Errico et al (QJRMS, 2010) are:
*
* 0.7 for SW, HU and TO
* 0.7 for dew-point depression and surfac pressure
* (12192 and 10051 of UA, AI, and SF)
* 1.0 for everything else.
*
* 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 "comnumbr.cdk"
#include "cvcord.cdk"
#include "comstato.cdk"
#include "comvcor.cdk"
#include "comstate.cdk"
#include "comfilt.cdk"
#include "comcva.cdk"
#include "comstato2.cdk"
#include "cparbrp.cdk"
*
REAL*8 GASDEV
INTEGER IBEGIN,ILAST,IDATA,IK,IBEGINOBS,INOBS,IOBS,ILASTOBS
INTEGER IERR, IELMGZ, IELMDZ, ILYR, ILEN
INTEGER IBAD1,IBAD2,IBAD3
INTEGER J,JDATA,JL,JVAR,jpos,INONZERO
REAL*8 XTEMP(JPMAXILEV,JPNMAXPRO), RESULT(JPMAXILEV,JPNMAXPRO)
REAL*8 ZRNDMEAN,ZRNDSTD
LOGICAL LLOK
C
REAL*8 STDSCALE(100),SCALE,STDSCALEDEF,STDSTR(100)
INTEGER ICASE,ISFC
INTEGER INSTR,INSTRUM
CHARACTER*2 SENSORTYPE
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 Set std. dev. scaling factors
C
ICASE=2 ! 0: no scaling; 1: Errico et al; >=2 further reduced
C ICASE=3
IBAD1=11
IBAD2=2
IBAD3=8
STDSCALEDEF=1.0
IF (ICASE.EQ.3) STDSCALEDEF=SQRT(2.0)
STDSCALE(:)=STDSCALEDEF
STDSTR(:)=0.6*STDSCALEDEF
DO J=1,NFILES
IF (CFAMTYP(J).EQ.'HU'.OR.CFAMTYP(J).EQ.'TO'.OR.
& CFAMTYP(J).EQ.'GO') THEN
C
C Most satellite obs
C
IF (ICASE.EQ.0) THEN
STDSCALE(J)=STDSCALEDEF
ELSE IF (ICASE.EQ.1) THEN
STDSCALE(J)=0.7*STDSCALEDEF
ELSE
STDSCALE(J)=0.5*STDSCALEDEF
END IF
ELSE IF (CFAMTYP(J).EQ.'SW') THEN
IF (ICASE.EQ.0.OR.ICASE.EQ.1) THEN
STDSCALE(J)=0.7*STDSCALEDEF
ELSE
STDSCALE(J)=0.4*STDSCALEDEF
STDSCALE(J)=0.69*STDSCALE(J)
END IF
ELSE IF (CFAMTYP(J).EQ.'RO') THEN
IF (ICASE.EQ.0.OR.ICASE.EQ.1) THEN
STDSCALE(J)=STDSCALEDEF
ELSE
STDSCALE(J)=STDSCALEDEF
END IF
ELSE IF (CFAMTYP(J).EQ.'PR') THEN
IF (ICASE.EQ.0.OR.ICASE.EQ.1) THEN
STDSCALE(J)=STDSCALEDEF
ELSE
STDSCALE(J)=0.8*STDSCALEDEF
STDSCALE(J)=0.72*STDSCALE(J)
END IF
ELSE IF (CFAMTYP(J).EQ.'AI') THEN
IF (ICASE.EQ.0.OR.ICASE.EQ.1) THEN
STDSCALE(J)=STDSCALEDEF
ELSE
STDSCALE(J)=0.6*STDSCALEDEF
STDSCALE(J)=0.94*STDSCALE(J)
END IF
ELSE IF (CFAMTYP(J).EQ.'SF') THEN
ISFC=J
IF (ICASE.EQ.0.OR.ICASE.EQ.1) THEN
STDSCALE(J)=STDSCALEDEF
ELSE
STDSCALE(J)=0.5*STDSCALEDEF
STDSCALE(J)=1.02*STDSCALE(J)
END IF
ELSE IF (CFAMTYP(J).EQ.'SC') THEN
ISFC=J
IF (ICASE.EQ.0.OR.ICASE.EQ.1) THEN
STDSCALE(J)=STDSCALEDEF
ELSE
STDSCALE(J)=0.5*STDSCALEDEF
STDSCALE(J)=1.02*STDSCALE(J)
END IF
ELSE IF (CFAMTYP(J).EQ.'TR') THEN
IF (ICASE.EQ.0.OR.ICASE.EQ.1) THEN
STDSCALE(J)=STDSCALEDEF
ELSE
STDSCALE(J)=STDSCALEDEF
! STDSTR(1)=0.4*STDSCALEDEF ! SBUV
! STDSTR(2)=1.4*STDSCALEDEF ! GOME2
END IF
ELSE
STDSCALE(J)=STDSCALEDEF
END IF
END DO
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
SCALE=STDSCALE(J)
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)*SCALE
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
IF (MOBDATA(NCMASS,JDATA).NE.1.OR.
& BTEST(MOBDATA(NCMFLG,JDATA),IBAD1).OR.
& BTEST(MOBDATA(NCMFLG,JDATA),IBAD2).OR.
& BTEST(MOBDATA(NCMFLG,JDATA),IBAD3).OR.
& ROBDATA8(NCMOER,JDATA).LE.0.0.OR.
& ROBDATA8(NCMVAR,JDATA).EQ.PPMIS) CYCLE
IOBS=MOBDATA(NCMOBS,JDATA)
SCALE=STDSCALE(J)
IF (CFAMTYP(J).EQ.'UA') THEN
IF (MOBDATA(NCMVNM,JDATA).EQ.NEUS.OR.
& MOBDATA(NCMVNM,JDATA).EQ.NEVS.OR.
& MOBDATA(NCMVNM,JDATA).EQ.NETS.OR.
& MOBDATA(NCMVNM,JDATA).EQ.NESS.OR.
& MOBDATA(NCMVNM,JDATA).EQ.NEPS.OR.
& MOBDATA(NCMVNM,JDATA).EQ.NEPN) SCALE=STDSCALE(ISFC)
ELSE IF (CFAMTYP(J).EQ.'TR') THEN
SCALE=STDSTR(1)
ELSE IF (CFAMTYP(J).EQ.'TO') THEN
INSTR = MOD(MOBHDR(NCMBOX,IOBS),10000)
CALL MAP_INSTRUM(INSTR,INSTRUM,SENSORTYPE)
C write(6,*) 'RANDOBS ',instr,instrum,jdata,trim(CSTNID(IOBS))
IF (trim(CSTNID(IOBS)).EQ.'^AQUA') THEN
if (instrum.eq.3) then !AMSUA
SCALE=SCALE*0.88
else if (instrum.eq.11) then !AIRS
SCALE=SCALE*0.62
end if
ELSE IF (trim(CSTNID(IOBS)).EQ.'^METOP-2') THEN
SCALE=SCALE*1.55
ELSE IF (trim(CSTNID(IOBS)).EQ.'^NOAA15') THEN
if (instrum.eq.3) then !AMSUA
SCALE=SCALE*0.67
else if (instrum.eq.4) then !AMSUB
SCALE=SCALE*1.19
end if
ELSE IF (trim(CSTNID(IOBS)).EQ.'^NOAA16') THEN
if (instrum.eq.3) then !AMSUA
SCALE=SCALE*0.67
else if (instrum.eq.4) then !AMSUB
SCALE=SCALE*2.50
end if
ELSE IF (trim(CSTNID(IOBS)).EQ.'^NOAA17') THEN
if (instrum.eq.3) then !AMSUA
SCALE=SCALE*0.67
else if (instrum.eq.4) then !AMSUB
SCALE=SCALE*0.71
end if
ELSE IF (trim(CSTNID(IOBS)).EQ.'^NOAA18') THEN
if (instrum.eq.3) then !AMSUA
SCALE=SCALE*0.82
else if (instrum.eq.15) then !MHS
SCALE=SCALE*0.60
end if
ELSE IF (trim(CSTNID(IOBS)).EQ.'^DMSP13') THEN
SCALE=SCALE*0.63
ELSE IF (trim(CSTNID(IOBS)).EQ.'^DMSP16') THEN
SCALE=SCALE*0.41
ELSE IF (trim(CSTNID(IOBS)).EQ.'^GOES11') THEN
SCALE=SCALE*0.16
ELSE IF (trim(CSTNID(IOBS)).EQ.'^GOES12') THEN
SCALE=SCALE*0.16
ELSE IF (trim(CSTNID(IOBS)).EQ.'^METSAT9') THEN
SCALE=SCALE*0.42
ELSE IF (trim(CSTNID(IOBS)).EQ.'^METSAT7') THEN
SCALE=SCALE*0.37
ELSE IF (trim(CSTNID(IOBS)).EQ.'^MTSAT-1R') THEN
SCALE=SCALE*0.45
END IF
END IF
ROBDATA8(NCMVAR,JDATA) = ROBDATA8(NCMVAR,JDATA) +
+ GASDEV(1)*ROBDATA8(NCMOER,JDATA)*SCALE
END DO
ENDIF
C
ENDIF
END DO
WRITE(NULOUT,*)'-END----------RANDOBS------------------END-'
RETURN
END