SUBROUTINE CH_GETMATX(KBUFRN,KHR,KLIST,PVALUES,PMAT, 2 & KNELE,KNLVLS,KDIM,KCOL,KNT,KIND) IMPLICIT NONE * INTEGER KBUFRN,KHR,KDIM,KCOL INTEGER KNELE,KNLVLS,KNT,KIND INTEGER KLIST(KNELE) * REAL*8 PVALUES(KNELE,KNLVLS,KNT),PMAT(KDIM,KCOL) * #if defined (DOC) ************************************************************************ * * PURPOSE: OBTAIN MATRIX CONTAINED IN A 3-D BLOCK OF DATA * EXTRACTED FROM A BURP FILE * * AUTHOR: Y.J. Rochon *ARQX/MSC Aug 2010 * (starting with GETELE by P. KOCLAS (CMC TEL. 4665)) * Revision: * * ARGUMENTS: * INPUT: * -KBUFRN : BUFR ELEMENT NUMBER * -KHR : SPECIFIED THIRD DIMENSION VALUE * -KLIST : LIST OF BUFR ELEMENTS * -PVALUES : DATA BLOCK * -KNELE : NUMBER OF ELEMENTS IN DATA BLOCK * -KNLVLS : NUMBER OF LEVELS IN DATA BLOCK * -KNT : THIRD DIMENSION OF DATA BLOCK * -KIND : LOCATION-1 FROM WHICH SEARCH IS TO START * -KDIM : Max row size of PMAT * -KCOL : Known number of columns * * OUTPUT: * -PMAT : OUTPUT MATRIX * -KIND : = INDEX OF ARRAY KLIST WHERE KBUFRN * WAS FOUND * = -1 IF NOT FOUND THIRD DIMENSION * NOT FOUND * ************************************************************************ #endif * #include "comlun.cdk"
* INTEGER JJ,JL INTEGER II,IC * ************************************************************************* * II=KIND+1 KIND=-1 IC=0 DO JL=II,KNELE IF ( KLIST(JL).EQ.KBUFRN ) THEN IC=IC+1 DO JJ=1,KNLVLS PMAT(JJ,IC)=PVALUES(JL,JJ,KHR) END DO IF (IC.EQ.KCOL) exit ENDIF END DO IF (IC.EQ.KCOL) KIND=JL * RETURN END