SUBROUTINE CH_CMABDY(PVALUES,KLIST,KFLAGS,POER,LDERR, 1,1
+ KNUM,KSPEC,KIELE,KELE,KVAL,KNT,KNDAT,
+ K2CORD,KNVCORD,PVCORD,PVCORD2,KINDEX,KOBSTYP,
+ PLONG,PLAT,CDSTNID)
IMPLICIT NONE
*
CHARACTER*(*) CDSTNID
*
INTEGER KNDAT,KNVCORD,KNUM,KSPEC,KIELE
INTEGER KELE,KVAL,KNT,KINDEX,KLIST(KELE)
INTEGER KFLAGS(KELE,KVAL,KNT),KOBSTYP,K2CORD
*
REAL*8 PVALUES(KELE,KVAL,KNT),PLONG,PLAT
REAL*8 PVCORD(KVAL),PVCORD2(KVAL),POER(KVAL)
*
LOGICAL LDERR
*
#if defined (DOC)
************************************************************************
*
****s/r CMABDY - FILL BODY OF CMA REPORT FOR SPECIES OBS ONLY
*
*Author . Y.J. Rochon ARQX/MSC June 2005
* Adapted from CMABDY by P. KOCLAS(CMC TEL. 4665)
*
*Revision: (see cmabdy.ftn)
* . Y. Yang April 2004
* - Added PVCORD2 in the argument to store the extra column
* for lower boundary of layers.
* - For column data, stores the lower boundary of layer into
* robdata8(NCMPOB, *)in addition to upper boundary of layer
* which goes into robdata8(NCMPPP, *).
* . Y.J. Rochon June 2005 - June3 2006, Jan/Feb 2007
* - Re-organization and additions
* - Addition of PLONG and PLAT input argument
* - Discarding of MIPAS_ESA (STNID) data below 100hPa
* (as requested for ESA-contract).
* . Y.J. Rochon Aug 2010
* - Introduced used of CH_KGETPOS and QCFACT2
*
*
* PURPOSE : TRANSFER DATA BLOCKS EXTRACTED FROM CMC BURP FILES TO
* THE IN-CORE FORMAT (CMA) OF THE 3-D VARIATIONAL ANALYSIS
*
* ARGUMENTS:
* INPUT:
*
* -PVALUES : Data profile
* -POER : Obs std. dev. profile
* -KFLAGS : QUALITY CONTROL FLAGS
* -KLIST : List of elements in block
* -LDERR : .FALSE. --> INSERT STD. DEV. ERROR IN CMA
* -KNUM : Number of relevant obs in BURP block
* -KSPEC : Species identifier
* -KIEVE : ELEMENT INDEX
* -KELE : NUMBER OF ELEMENTS
* -KVAL : NUMBER OF LEVELS
* -KNT : THIRD DIMENSION
* -KNVCORD : Coordinate type index
* -K2CORD : >0 implies use of PVCORD2
* -PVCORD : VERTICAL COORDINATE VALUES
* -PVCORD2 : SECOND VERTICAL COORDINATE VALUES IF REQUIRED
* -KINDEX : THIRD INDEX OF DATA BLOCK
* -KOBSTYP : Index for forward/TLM model specification
* -PLONG : Longitude (degrees)
* -PLAT : Latitude (degrees)
*
* OUTPUT:
* -KNDAT : AMOUNT OF DATA INSERTED IN CMA FILE
*
* COMMENTS:
*
* IMPORTANT: Obs counting in CH_BDY2BRP (and CH_BDY2BUF)
* must be consistent with that in CH_BRP2BDY
* (and CH_CMABDY). Otherwise, there will be a position
* mismatch between the required CMA data and the BURP
* report content (i.e. counting with NDATA - see BDY2BUF).
*
* Modules should be cleaned up (removal of tempory considerations)
* before becoming official.
*
*************************************************************************
#endif
*
#include "comdim.cdk"
#include "comdimo.cdk"
#include "comoabdy.cdk"
#include "comoahdr.cdk"
#include "comoba.cdk"
#include "comnumbr.cdk"
#include "cvcord.cdk"
#include "cparbrp.cdk"
#include "comcst.cdk"
#include "comfilt.cdk"
#include "comlun.cdk"
#include "comchem.cdk"
*
INTEGER IND,IP,IK,IFLAG,IASS,IDIR,ILEM
REAL ZVAL
INTEGER JI,JJ,J1
LOGICAL LLGOOD
INTEGER CH_KGETPOS
EXTERNAL CH_KGETPOS
*
REAL*8 padd,pmul,deg2rad
*
IP=NDATA + 1
IND=0
*
************************************************************************
* PUT ALL REQUESTED DATA IN CMA FILE
* EXIT IF THERE IS MORE DATA AVAILABLE THAN ALLOCATED TO CMA FILE
************************************************************************
*
JI=KIELE
IK= KINDEX
C
C Identify order position as provided under NAMGEM namelist.
C
IF (KSPEC.gt.0) THEN
ILEM = CH_KGETPOS(KLIST(JI),KSPEC,CDSTNID)
IF (ILEM.LE.0) THEN
write(nulout,*) KLIST(JI),KSPEC,CDSTNID
CALL ABORT3D(NULOUT,'CH_CMABDY: Unidentified obs')
END IF
END IF
C
IDIR=-1
IF (KLIST(JI).EQ.NEDW) THEN
C
C Will need to store observing direction of Doppler wind speed
C
DO JJ=1,KELE
IF (KLIST(JJ).EQ.NOBSLOS(1)) THEN
IDIR=JJ
EXIT
END IF
END DO
IF (IDIR.EQ.-1) THEN
WRITE(NULOUT,*)' CH_CMABDY: Missing dir. angle - CALL ABORT3D '
call abort3d(nulout,'CH_CMABDY')
END IF
deg2rad=RPI/180.0D0
END IF
C
DO JJ=1,KVAL
C
C Test on flags and obs values
C
IFLAG=KFLAGS(JI,JJ,IK)
ZVAL=PVALUES(JI,JJ,IK)
C
C Verify validity of data.
C
c IASS=0
c DO J1=1,NTOTTRFLAG
c IF (IFLAG.EQ.NTRFLAG(J1)) IASS=1
c END DO
IASS=1
C
LLGOOD=(ZVAL.NE.PPMIS.AND.IASS.EQ.1.AND.ZVAL.LT.1.E28)
IF (KSPEC.GT.0) THEN
LLGOOD=(LLGOOD.AND.ZVAL.GT.0.0.AND.ZVAL.NE.PPMIS)
C
IF (CDSTNID(1:9).EQ.'MIPAS_ESA'.AND.PVCORD(JJ).GT.10000.0) THEN
cc IF (CDSTNID(1:9).EQ.'AURAMLS00'.AND.(PVCORD(JJ).GT.7000.0.OR.
cc & PVCORD(JJ).LT.19.0)) THEN
LLGOOD=.FALSE.
IFLAG=2048
c WRITE(NULOUT,*)' CH_CMABDY: Suspicious data rejected: ',
c & PVCORD(JJ),ZVAL,POER(JJ),KSPEC,K2CORD,KOBSTYP,
c & ' ',CDSTNID
ELSE IF (.NOT.LDERR.AND.LLGOOD) THEN
IF (POER(JJ).LE.1.0D-28.OR.POER(JJ).GE.1.0D28.OR.
& ZVAL.GT.QCFACT2(ILEM)*POER(JJ).OR.ZVAL.LT.0.1*POER(JJ)) THEN
LLGOOD=.FALSE.
IFLAG=2048
c WRITE(NULOUT,*)' CH_CMABDY: Suspicious data rejected: ',
c & PVCORD(JJ),ZVAL,POER(JJ),KSPEC,K2CORD,KOBSTYP,
c & ' ',CDSTNID
ELSE IF (KSPEC.EQ.2) THEN
C
C It is assumed that KSPEC=2 refers to humidity. This
C must be consistent with the content of the 'tablespecies'
C file!
C
C Verification only done for obs in vmr!
C
IF ((KLIST(JI).EQ.15026.OR.KLIST(JI).EQ.15008.OR.
& KLIST(JI).EQ.15197)
& .AND.ZVAL.LT.RMINHU) THEN
LLGOOD=.FALSE.
IFLAG=2048
c WRITE(NULOUT,*) ' CH_CMABDY: Low humidity - rejected: ',
c & KLIST(JI),ZVAL,POER(JJ),KSPEC,
c & ' ',CDSTNID
END IF
END IF
END IF
ELSE IF (KLIST(JI).EQ.12001) THEN
C
C Screening out of suspicious temperature observations
C
IF (CDSTNID(1:9).EQ.'MIPAS_ESA'.AND.
& PVCORD(JJ).GT.10000.0) THEN
C
LLGOOD=.FALSE.
IFLAG=2048
c WRITE(NULOUT,*)' CH_CMABDY: Suspicious data rejected: ',
c & PVCORD(JJ),ZVAL,POER(JJ),KSPEC,K2CORD,KOBSTYP,PLAT,
c & ' ',CDSTNID
ELSE IF (POER(JJ).GT.22.0.OR.POER(JJ).LT.0.1.OR.
& ZVAL.LT.50.0.OR.ZVAL.GT.400.0) THEN
c ELSE IF (POER(JJ).GT.22.0.OR.POER(JJ).LT.0.1.OR.
c & ZVAL.LT.100.0.OR.ZVAL.GT.350.0.OR.
c & (PLAT.GT.-30.0.AND.PLAT.LT.30.0.AND.
c & PVCORD(JJ).GT.1000.0.AND.KNVCORD.EQ.2.)) THEN
C
C NOTE: Condition for exclusion of T obs in tropics below
C 10 hPa (1000 Pa) is to prevent appearance of
C distortions on species fields, i.e. the so-called
C wiggles, when running in 3D-var mode.
C
LLGOOD=.FALSE.
IFLAG=2048
c WRITE(NULOUT,*)' CH_CMABDY: Suspicious data rejected: ',
c & PVCORD(JJ),ZVAL,POER(JJ),KSPEC,K2CORD,KOBSTYP,PLAT,
c & ' ',CDSTNID
ELSE
C
C Add tropical bias
C
c if (PVCORD(JJ).GT.250.0.and.PVCORD(JJ).LT.4000.0
c & .and.PLAT.LT.7.5.AND.PLAT.GT.-22.5) THEN
c ZVAL=ZVAL
c & -4.*sin(3.1415*LOG(PVCORD(JJ)/1000.D0)/
c & LOG(0.25D0))
c & *sin(3.1415*(PLAT+7.5)/15.0)
c end if
END IF
END IF
IF ( IP + IND .GT. NDATAMX ) THEN
WRITE(NULOUT,*)' CH_CMABDY: CMA FILE FULL - CALL ABORT3D '
call abort3d(nulout,'CH_CMABDY')
END IF
C
C VERTICAL COORDINATE
C
C Store reference vertical level.
C
ROBDATA8(NCMPPP,IP+IND)=PVCORD(JJ)
C
if (K2CORD.GT.0) then
C
C For column integrals/averages, store the lower boundary
C of layer into ROBDATA8(NCMPOB,IP+IND)
C in addition to upper boundary of layer
C which goes into ROBDATA8(NCMPPP,IP+IND).
C
ROBDATA8(NCMPOB,IP+IND)=PVCORD2(JJ)
ELSE
ROBDATA8(NCMPOB,IP+IND)=-1.0
endif
C
MOBDATA(NCMFLG,IP+IND)=IFLAG
MOBDATA(NCMSPEC,IP+IND)=KSPEC
MOBDATA(NCMVNM,IP+IND)=KLIST(JI)
MOBDATA(NCMVCO,IP+IND)=KNVCORD
MOBDATA(NCMCORD1,IP+IND)=KOBSTYP
ROBDATA8(NCMOMF,IP+IND)=PPMIS
ROBDATA8(NCMOMA,IP+IND)=PPMIS
ROBDATA8(NCMOMI,IP+IND)=PPMIS
ROBDATA(NCMFGE,IP+IND)=PPMIS
ROBDATA8(NCMOER,IP+IND)=PPMIS
ROBDATA(NCMDWN,IP+IND)=PPMIS
C
IF (LLGOOD) THEN
C
C NOTE: Could apply CVT3D for unit conversion
C if so required/desired. Currently commented out as all
C unit conversions done in forward and adjoint models since some
C conversions may depend on temperature and pressure. See
C module CH_CONVERT.
C
C padd=0.0D0
C pmul=1.0D0
C CALL CVT3D(ZVAL,padd,pmul,1)
C
ROBDATA8(NCMVAR,IP+IND)=ZVAL
MOBDATA(NCMASS,IP+IND)=1
C
C Store obs error std. if available.
C
IF (.NOT.LDERR) THEN
ROBDATA8(NCMOER,IP+IND)=POER(JJ)
ENDIF
C
C Store observing direction
C
IF (IDIR.GT.0) ROBDATA(NCMDWN,IP+IND)=PVALUES(IDIR,JJ,IK)
& *deg2rad
C
ELSE
C
C Keep CMA space for invalid/missing data in profile to avoid
C any ordering mixup in going back from CMA to BURP during
C postprocessing.
C
ROBDATA8(NCMVAR,IP+IND)=PPMIS
MOBDATA(NCMASS,IP+IND)=0 ! Flagged as not usable.
ENDIF
IND=IND+1
END DO
C
KNDAT = IND
IF (IND.GT.0) MOBDATA(NCMNUM1,IP+0:IP+IND-1) = IND
C
NDATA = NDATA + KNDAT
C
RETURN
END