SUBROUTINE CH_GETCMA(PVALUES,KFLAGS,KJI, 2 + KELE,KVAL,KNT,KNDAT,KINDEX,KRVAL, + KPRESS,PRESS) * IMPLICIT NONE * INTEGER KNDAT,KRVAL,KJI,KPRESS INTEGER KELE,KVAL,KNT,KINDEX INTEGER KFLAGS(KELE,KVAL,KNT) * REAL*8 PVALUES(KELE,KVAL,KNT),PRESS(KVAL) * #if defined (DOC) ************************************************************************ * ****s/r CH_GETCMA - GET IDENTIFIED PROFILE/DATA FROM CMA AND INSERT * IN A BURP FILE BLOCK ARRAY. * *Author . Y.J. Rochon ARQX/EC Feb 2006 * Based on GETCMA by P. KOCLAS(CMC/CMSV TEL. 4628) * *Revision: (see GETCMA) * Y.J. Rochon ARQX/EC Feb 2007 * - Removed use of NEHU and NEHS * Added PVALUES (KJI,JJ,IK)=PPMIS * for MOBDATA(NCMASS,IP+IND1).NE.1 * Y.J. Rochon ARQX/EC Aug 2010 * - Added KPRESS and PRESS * * PURPOSE : GET IDENTIFIED PROFILE/DATA FROM CMA AND INSERT * IN A BURP FIL BLOCK ARRAY. * * ARGUMENTS: * INPUT: * * -PVALUES : Initial data block * -KFLAGS : Initial marker block * -KJI : Identified element index * -KELE : NUMBER OF ELEMENTS IN DATA BLOCK * -KVAL : NUMBER OF LEVELS IN DATA BLOCK * -KNT : THIRD DIMENSION OF DATA BLOCK * -KINDEX : THIRD DIMENSION INDEX OF DATA BLOCK * -KRVAL : INDEX OF ELEMENT IN CMA LIST * (e.g. identifier for OmA, OmP, ... ) * * OUTPUT: * -KNDAT : AMOUNT OF DATA INSERTED FROM CMA FILE * -PVALUES : Final daa block * -KFLAGS : Final marker block * -KPESS : Flag indicating if the model pressures * at the obs locations are provided as output * -PRESS(KVAL) : Output pressures if KPRESS>0 * ************************************************************************ #endif c #include "comdimo.cdk"
#include "comoabdy.cdk"
#include "comoahdr.cdk"
#include "comoba.cdk"
#include "comnumbr.cdk"
#include "cvcord.cdk"
#include "cparbrp.cdk"
#include "comcst.cdk"
c INTEGER IND,IP,IK,IFLG,IND1 INTEGER JJ c REAL*8 ZERR,ZSTAT IP=NDATA + 1 IND=0 c c Check if vertical coordinate is in altitude. If so, provide pressures. c KPRESS=0 IF (KRVAL.EQ.NCMVAR.AND.MOBDATA(NCMVCO,IP).EQ.1) THEN KPRESS=1 PRESS(1:KVAL)=ROBDATA(NCMPPX,IP:IP+KVAL-1) END IF c c Update other values c IK= KINDEX DO JJ=1,KVAL IND1=JJ-1 IF (PVALUES(KJI,JJ,IK).NE.PPMIS) THEN IF ( IP + IND1 .LE. NDATAP ) THEN c IF (MOBDATA(NCMASS,IP+IND1).EQ.1 c & .AND.MOBDATA(NCMXTR,IP+IND1).NE.1) THEN ZERR= ROBDATA(NCMOER,IP+IND1) ZSTAT= ROBDATA(KRVAL, IP+IND1) IFLG= MOBDATA(NCMFLG,IP+IND1) * IF ( KRVAL .EQ. NCMOMF .OR. KRVAL .EQ. NCMOMA) THEN if (MOBDATA(NCMASS,IP+IND1).EQ.1) THEN PVALUES (KJI,JJ,IK)=-ZSTAT*ZERR else PVALUES (KJI,JJ,IK)=PPMIS endif ELSE IF (KRVAL .EQ. NCMOER) THEN PVALUES (KJI,JJ,IK)=ZERR ELSE PVALUES (KJI,JJ,IK)=ZSTAT KFLAGS (KJI,JJ,IK)=IFLG ENDIF c ELSE c PVALUES (KJI,JJ,IK)=PPMIS c ENDIF IND=IND + 1 ELSE KNDAT = IND NDATA = NDATA + KNDAT RETURN ENDIF ENDIF END DO *============================= KNDAT = KVAL NDATA = NDATA + KNDAT *============================= * RETURN END