!-------------------------------------- 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 IGETELE(KBUFRN,KHR,KLIST,KVALUES,KPROF 62 & ,KNELE,KNLVLS,KNT,KIND) IMPLICIT NONE * INTEGER KBUFRN,KHR INTEGER KNELE,KNLVLS,KNT,KIND INTEGER KLIST(KNELE) * INTEGER KVALUES(KNELE,KNLVLS,KNT),KPROF(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) * * ARGUMENTS: * INPUT: * -KBUFRN : BUFR ELEMENT NUMBER * -KHR : SOUGHT 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 * * 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 getele * ************************************************************************ #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 *========================================== KPROF(JJ)=KVALUES(II,JJ,IK) *========================================== 3 CONTINUE RETURN ENDIF 1 CONTINUE RETURN * END