SUBROUTINE CH_IGETELEX(KBUFRN,KHR,KLIST,KVALUES,KPROF & ,KNELE,KNLVLS,KNT,KIND) IMPLICIT NONE * INTEGER KBUFRN,KHR INTEGER KNELE,KNLVLS,KNT,KIND INTEGER KLIST(KNELE) * REAL*8 KVALUES(KNELE,KNLVLS,KNT),KPROF(KNLVLS) * #if defined (DOC) ************************************************************************ * * PURPOSE: TO OBTAIN THE VERTICAL PROFILE OF AN ELEMENT * CONTAINED IN A 3-D BLOCK OF DATA EXTRACTED FROM A BURP * FILE * * AUTHOR: Y.J. Rochon *ARQX/MSC May 2005 * (starting with IGETELE by P. KOCLAS (CMC TEL. 4665)) * Revision: * Y.J. Rochon *ARQX/MSC May 2005 * - Start search at KIND+1 location * * ARGUMENTS: * INPUT: * -KBUFRN : BUFR ELEMENT NUMBER * -KHR : SPECIFIED THIRD DIMENSION VALUE * -KLIST : LIST OF BUFR ELEMENTS * -KVALUES : 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 * * OUTPUT: * -KPROF : OUTPUT PROFILE * -KIND : = INDEX OF ARRAY KLIST WHERE KBUFRN * WAS FOUND * = -1 IF NOT FOUND THIRD DIMENSION * NOT FOUND * * NOTE: This subroutine is an integer version of subroutine ch_getelex * ************************************************************************ #endif * #include "comlun.cdk"
* INTEGER JJ,JL INTEGER II * ************************************************************************* * II=KIND+1 KIND=-1 DO JL=II,KNELE IF ( KLIST(JL) .EQ. KBUFRN ) THEN DO JJ=1,KNLVLS KPROF(JJ)=KVALUES(JL,JJ,KHR) END DO KIND=JL RETURN ENDIF END DO * RETURN END