!-------------------------------------- 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 GETELE(KBUFRN,KHR,KLIST,PVALUES,PPROF 40 & ,KNELE,KNLVLS,KNT,KIND) IMPLICIT NONE * INTEGER KBUFRN,KHR INTEGER KNELE,KNLVLS,KNT,KIND INTEGER KLIST(KNELE) * REAL*8 PVALUES(KNELE,KNLVLS,KNT),PPROF(KNLVLS) * #if defined (DOC) ************************************************************************ * * PURPOSE: TO OBTAIN THE VERTICAL PROFILE OF A WEATHER ELEMENT * CONTAINED IN A 3-D BLOCK OF DATA EXTRACTED FROM A BURP * FILE * * AUTHOR: P. KOCLAS (CMC TEL. 4665) * Revision: * P. Koclas *CMC/CMDA February 95 * -changed the calling sequence to explicitly state * which index of the 3rd dimension of the data block * is sought in the output profile * * ARGUMENTS: * INPUT: * -KBUFRN : BUFR ELEMENT NUMBER * -KHR : SOUGHT 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 * * OUTPUT: * -PPROF : OUTPUT PROFILE * -KIND : = INDEX OF ARRAY KLIST WHERE KBUFRN * WAS FOUND * = -1 IF NOT FOUND THIRD DIMENSION * NOT FOUND * ************************************************************************ #endif * INTEGER JJ,JL INTEGER II,IK * ************************************************************************* * KIND=-1 IK=KHR DO 1 JL=1,KNELE IF ( KLIST(JL) .EQ. KBUFRN ) THEN II=JL KIND=II DO 3 JJ=1,KNLVLS *========================================== PPROF(JJ)=PVALUES(II,JJ,IK) *========================================== 3 CONTINUE RETURN ENDIF 1 CONTINUE RETURN * END