SUBROUTINE CH_RDBRPBLK(K,KNBUF,KBUF,KSTELE,K1TBL,K2TBL,KTBL, 4 & PVAL,KVALUES,KLIST,KNELE,KNVAL,K3D) IMPLICIT NONE * INTEGER K,KNBUF,K1TBL,K2TBL INTEGER KBUF(KNBUF),KTBL(K1TBL,K2TBL) * INTEGER KSTD,KLIST(KNELE),KNELE,KNVAL,K3D INTEGER KSTELE(KNELE) INTEGER KVALUES(KNELE*KNVAL*K3D) REAL*8 PVAL(KNELE*KNVAL*K3D) * #if defined (DOC) * ***s/r CH_RDBRPBLK - EXTRACT ALL DATA FROM INDIVIDUAL BLOCK CONTAINED * IN A BURP FILE. * *Author . Y.J. Rochon *AQRB/MSC May 2005, Feb 2006 * *Revision: * * PURPOSE: EXTRACT DATA FROM INDIVIDUAL BLOCK CONTAINED * IN A BURP FILE. * * ARGUMENTS: * * INPUT: * -K : Block index * -KNBUF : Dimension of KBUF * -KBUF : Block report * -K1TBL : First dimension of KTBL * -K2TBL : Second dimension of KTBL * -KTBL : Block header info * * OUTPUT: * * -PVAL : Data from block * -KVALUES : Undecoded data from block * -KSTELE : Undecoded list of BUFR elements * -KLIST : Decoded BUFR element names * (in 6 digit decimal BUFR format) * -KNELE : NUMBER OF ELEMENTS IN DATA BLOCK * -KNVAL : NUMBER OF VETICAL LEVELS from block header * -K3D : Third dimension (for 3D blocks) * #endif * #include "comlun.cdk"
#include "comdim.cdk"
#include "cparbrp.cdk"
* INTEGER IER,IDATYP,J,INUM REAL*4 Z4VAL C INTEGER MRBLOCX,MRBXTR,VMRBCVT,MRBDCL EXTERNAL MRBLOCX,MRBXTR,VMRBCVT,MRBDCL C Z4VAL=0.0 C KNELE =KTBL(2,K) KNVAL =KTBL(3,K) K3D =KTBL(4,K) INUM=KNELE*KNVAL*K3D IDATYP=KTBL(10,K) C IER=MRBXTR(KBUF,K,KSTELE,KVALUES) C IF (IDATYP.EQ.2.OR.IDATYP.EQ.4) THEN C C Block contains integer values. Convert to real. C IER=VMRBCVT(KSTELE,KVALUES,PVAL, & KNELE,KNVAL,K3D,0) C ELSE IF (IDATYP.EQ.6) THEN C C Block contains R*4 values C DO J=1,INUM PVAL(J)=TRANSFER(KVALUES(J),Z4VAL) END DO C END IF C C Convert KSTELE to decoded list KLIST C IER=MRBDCL(KSTELE,KLIST,KNELE) C RETURN END