!-------------------------------------- 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 vintprof(pprofo,plevo,klevo,pprofi,plevi,klevi,kprof) 8 #if defined (DOC) * ***s/r vintprof - Vertical interpolation of pressure defined profile * * *Author : S. Pellerin *ARMA/AES November 1999 *Revision: * ** Purpose: -Interpolate vertically the contents of input pressure * defined profile another set of pressure define profile. * A linear interpolation in ln(p) is performed. * * *Arguments * Output: * pprofo: vector of output profiles * Input : * plevo : pressure values of output profiles * klevo : number of output levels * pprofi: vector of input profiles * plevi : pressure values of input profiles * klevi : number of input levels * kprof : number of profiles * #endif IMPLICIT NONE *implicits * integer klevo,klevi,kprof real*8 pprofo(klevo,kprof),plevo(klevo,kprof),pprofi(klevi,kprof) real*8 plevi(klevi,kprof) c integer jlevo,jlevi,jprof real*8 zwb,zwt c do jprof = 1, kprof jlevi = 1 do jlevo = 1, klevo jlevi = jlevi + 1 do while(plevo(jlevo,jprof).gt.plevi(jlevi,jprof).and.jlevi.lt & .klevi) jlevi = jlevi + 1 enddo jlevi = jlevi - 1 zwb = log(plevo(jlevo,jprof)/plevi(jlevi,jprof)) & /log(plevi(jlevi+1,jprof)/plevi(jlevi,jprof)) zwt = 1. - zwb pprofo(jlevo,jprof) = zwb*pprofi(jlevi+1,jprof) + zwt & *pprofi(jlevi,jprof) enddo enddo c RETURN END