!-------------------------------------- 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 CMABDY(PVALUES,KLIST,KFLAGS,LDFLAG,PROFIL,LDERR,LDSAT, 4,7
+ LDGO,LDAIRS,LDIASI,KELE,KVAL,KNT,KNDAT,KVCORD,PVCORD,KINDEX,KIDTYP)
IMPLICIT NONE
*
INTEGER KNDAT
INTEGER KELE,KVAL,KNT,KVCORD,KINDEX,KIDTYP
INTEGER KLIST(KELE)
INTEGER KFLAGS(KELE,KVAL,KNT)
*
REAL*8 PVALUES(KELE,KVAL,KNT),PVCORD(KVAL),PROFIL(KVAL)
*
LOGICAL LDFLAG,LDERR,LDSAT,LDGO,LDAIRS,LDIASI
*
#if defined (DOC)
************************************************************************
*
****s/r CMABDY -FILL BODY OF CMA REPORT
*
*Author . P. KOCLAS(CMC TEL. 4665)
*
*Revision:
* . P. Koclas *CMC/AES Sept 1994: Add call to cvt3d
* . before insertion of U and V for consistency
* . P. Koclas *CMC/AES February 1995:
* . New call sequence neccessary to :
* . -allow insertion of "grouped data" records in BURP files.
* . -allow data observed in various vertical coordinates
* . -observation errors no longer initialized
*
* . P. Koclas *CMC/AES March 1995:
* -Additions for humsat and satem data
* .
* . C. Charette *ARMA Jan 2001
* -Max value for T-Td surface element(12203)
*
* JM Belanger CMDA/SMC Feb 2001
* . 32 bits conversion
* . P. Koclas *CMC/CMDA Sept 2001:
* -set first-guess and observation errors to missing values
*
* .N Wagneur CMDA/SMC Jine 2002
* . -Additions for goes data
* . P. Koclas *CMC/CMDA Dec 2003:
* -conversion for surface wind
* . C. Charette *ARMA/SMC Apr 2005:
* -Set flag bit #12 (Element assimilated by analysis) to zero
* (see banco-burp documentation for more detail)
* . A. Beaulne *CMDA/SMC Aug 2006
* -Additions for AIRS data
* . S. Heilliette
* -Additions for IASI data
*
*
* 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 BLOCK
* -KLIST : LIST OF BUFR ELEMENTS
* -KFLAGS : QUALITY CONTROL FLAGS
*
* -LDFLAG : .TRUE. --> INSERT FLAGS IN CMA
* .FALSE. --> INSERT DUMMY VALUE(2**12)
* -LERR : .TRUE. --> INSERT OBS ERROR IN CMA (HUMSAT DATA)
* -LDSAT : .TRUE. --> INSERT REF PRESSURE IN CMA (SATEMS)
* -LDGO : .TRUE. --> INSERT EMISSIVITIES IN CMA (GOES RADIANCES)
* -LDAIRS : .TRUE. --> INSERT EMISSIVITIES IN CMA (AIRS RADIANCES)
* -LDIASI : .TRUE. --> INSERT EMISSIVITIES IN CMA (IASI RADIANCES)
*
* -KELE : NUMBER OF ELEMENTS IN DATA BLOCK
* -KVAL : NUMBER OF LEVELS IN DATA BLOCK
* -KNT : THIRD DIMENSION OF DATA BLOCK
* -KNDAT : THIRD DIMENSION OF DATA BLOCK
* -KVCORD : BUFR ELEMENT CODE OF VERTICAL COORDINATE
* -PVCORD : VERTICAL COORDINATE VALUES EXTRACTED FROM DATA BLOCK
* -KINDEX : THIRD DIMENSION INDEX OF DATA BLOCK
*
* OUTPUT:
* -KNDAT : AMOUNT OF DATA INSERTED IN CMA FILE
*
************************************************************************
#endif
*
#include "comdimo.cdk"
#include "comoabdy.cdk"
#include "comoahdr.cdk"
#include "comoba.cdk"
#include "cvcord.cdk"
#include "cparbrp.cdk"
#include "comcst.cdk"
#include "comfilt.cdk"
INTEGER IFIND
INTEGER ILEM,IND,IIND,IP,IK
INTEGER IBAD,IFLAG
INTEGER JI,JJ
INTEGER ZESMAX,ZES
*
REAL*8 ZTORAD,ZFACT,padd,pmul,ZEMFACT
*
************************************************************************
* SET BAD FLAG VALUE IIND AND UNIT CONVERSION CONSTANTS
************************************************************************
*
IIND =-1
IBAD=2**11
ZTORAD=RPI/180.
*
ZFACT=VCONV
*
ZEMFACT=0.01
*
ZESMAX=30.
*
IP=NDATA + 1
IND=0
*
************************************************************************
* PUT ALL NON MISSING DATA IN CMA FILE
* EXIT IF THERE IS MORE DATA AVAILABLE THAN ALLOCATED TO CMA FILE
* DATA IS CONVERTED TO UNITS USED BY 3D-VAR ANALYSIS.
************************************************************************
*
IK= KINDEX
DO JI=1,KELE
ILEM=IFIND(KLIST(JI))
IF ( (ILEM .GT. 0) .AND. (KLIST(JI) .NE. KVCORD) ) THEN
DO JJ=1,KVAL
if(pvcord(jj) .ne. ppmis .and. (nonelev .eq. -1 .or.
& nonelev .eq. nint(pvcord(jj)*zfact))) then
IF ( PVALUES (JI,JJ,IK) .NE. PPMIS ) THEN
IF ( IP + IND .LE. NDATAMX ) THEN
* VERTICAL COORDINATE
ROBDATA8(NCMPPP,IP+IND)=PVCORD(JJ)*ZFACT +vcordsf(ilem,kidtyp)
C
C FOR PNM HEIGHT IS SET TO 0
C ----------------------------
IF ( ILEM .EQ. 53 ) THEN
ROBDATA8(NCMPPP,IP+IND)=0.
ENDIF
C ----------------------------
C
IF ( ILEM .EQ. 1 ) THEN
padd=0.0D0
pmul=1.0D0
CALL CVT3D(PVALUES(JI,JJ,IK),padd,pmul,1)
ENDIF
* CONVERT TO V
IF ( ILEM .EQ. 2 ) THEN
padd=0.0D0
pmul=1.0D0
CALL CVT3D(PVALUES(JI,JJ,IK),padd,pmul,1)
ENDIF
* CONVERT TO GZ
IF ( ILEM .EQ. 3 ) THEN
padd=0.0D0
pmul=RG
CALL CVT3D(PVALUES(JI,JJ,IK),padd,pmul,1)
ENDIF
* CONVERT THIKNESSES TO METERS
IF ( ILEM .EQ. 4 ) THEN
padd=0.0D0
pmul=1.0D0
CALL CVT3D(PVALUES(JI,JJ,IK),padd,pmul,1)
ENDIF
* CONVERT TO CELSIUS
IF ( ILEM .EQ. 8 ) THEN
padd=0.0D0
pmul=1.0D0
CALL CVT3D(PVALUES(JI,JJ,IK),padd,pmul,1)
ENDIF
* Max value T-Td upper air
IF ( ILEM .EQ. 9 ) THEN
IF ( PVALUES(JI,JJ,IK) .GT. ZESMAX) THEN
PVALUES(JI,JJ,IK)=ZESMAX
ENDIF
ENDIF
* Max value T-Td surface
IF ( ILEM .EQ. 11 ) THEN
IF ( PVALUES(JI,JJ,IK) .GT. ZESMAX) THEN
PVALUES(JI,JJ,IK)=ZESMAX
ENDIF
ENDIF
* CONVERT TO RADIANS
IF ( ILEM .EQ. 48 .OR. ILEM .EQ. 54 ) THEN
padd=0.0D0
pmul=ZTORAD
CALL CVT3D(PVALUES(JI,JJ,IK),padd,pmul,1)
ENDIF
* FLAGS
IF (LDFLAG) THEN
* SET BIT 12 TO ZERO
* (Element assim by 3dvar)
IFLAG = KFLAGS(JI,JJ,IK)
IFLAG = IBCLR(IFLAG,12)
MOBDATA(NCMFLG,IP+IND)= IFLAG
ELSE
MOBDATA(NCMFLG,IP+IND)= IBAD
ENDIF
*
ROBDATA8(NCMVAR,IP+IND)=PVALUES (JI,JJ,IK)
MOBDATA(NCMVNM,IP+IND)=KLIST(JI)
MOBDATA(NCMVCO,IP+IND)=NVCORDTYP
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
*
* OBS ERROR FOR HUMSAT
*
IF ( LDERR ) THEN
ROBDATA8(NCMOER,IP+IND)=PROFIL(JJ)
ENDIF
*
* REFERENCE LEVEL FOR SATEMS
*
IF ( LDSAT ) THEN
ROBDATA8(NCMPRL,IP+IND)=PROFIL(JJ)*ZFACT
ROBDATA8(NCMOER,IP+IND)=1.0D0
ENDIF
*
* SURFACE EMISSIVITIES FOR GOES AIRS AND IASI RADIANCES
*
IF ( LDGO ) THEN
ROBDATA8(NCMPRL,IP+IND)=PROFIL(JJ)
& *ZEMFACT
ENDIF
IF ( LDAIRS ) THEN
ROBDATA8(NCMPRL,IP+IND)=PROFIL(JJ)
& *ZEMFACT
END IF
IF ( LDIASI ) THEN
ROBDATA8(NCMPRL,IP+IND)=PROFIL(JJ)
& *ZEMFACT
END IF
*
IND=IND + 1
ELSE
*==================================================
KNDAT = IND
NDATA = NDATA + KNDAT
*==================================================
RETURN
ENDIF
ENDIF
ENDIF
END DO
ENDIF
END DO
*=============================
KNDAT = IND
NDATA = NDATA + KNDAT
*=============================
*
RETURN
*
END