!-------------------------------------- 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 INTAVG (PVLEV,PVI,KNIDIM,KNI,KNPROF,KNO,PPO,PVO) 2,1
C
#if defined (DOC)
*
*--------------------------------------------------------------------
*
***s/r INTAVG - Forward interpolator based on piecewise
* weighted averaging.
*
*Author : Y.J. Rochon *ARQX/EC Nov 2005
* Starting points: LINTV2, LLINTV2, and ALINTV2 by J. Halle et al.
*
*Revisions:
* Saroja Polavarapu *ARMA/EC Nov 2005
* - Completed split into three routines for consistency with
* LINTV2, LLINTV2, and ALINTV2 by J. Halle et al.
*Arguments
* i KFLAG : Indicates purpose of calc
* 0 - Application of TLM as forward model
* 1 - Application as TLM with increments
* 2 - Setting of adjoint elements
* i PVLEV(KNIDIM,KNPROF) : Vertical levels, pressure (source)
* i/o PVI(KNIDIM,KNPROF) : kflag=0, Input vector to be interpolated (source)
* kflag=1, Input increments of above
* kflag=2, Output adjoint of above
* i PVIG(KNIDIM,KNPROF) : kflag>0, Vector to be interpolated (source)
* Not used otherwise
* i/o PPS(KNPROF) : kflag=0, Not needed (source)
* kflag=1, Input surface pressure increments
* kflag=2, Output adjoint of above
* i KNIDIM : Dimension of input levels (source)
* i KNI : Number of input levels (source)
* i KNPROF : Number of profiles
* i KNO : Number of output levels (destination)
* i PPO(KNO) : Vertical levels, pressure (destination)
* o/i PVO(KNO,KNPROF) : kflag=0, Output interpolated profiles (destination)
* kflag=1, Output increments of above
* kflag=2, Input adjoint of above
*
* -------------------
*
**Purpose: Forward interpolator based on piecewise
* weighted averaging in log of pressure
* of one-dimensional vectors.
*
* Comments:
*
* 1) vlev in eta coordinate associated to pvlev in pressure.
*
* 2) Cases:
*
* a) KFLAG=0 for application as forward interpolator
*
* Y = sum(H*PVI)
* = PVO
*
* with ZPZ=H on output of LAYERAVG
*
* b) KFLAG=1 for TLM case:
*
* dY = sum(H*PVI) + PPS*sum(PVIG*dH/dPs))
* = ZPVO + ZPVOPS
* = PVO
*
* where
*
* dPZ(i)/dPs = sum_k (dH(i)/dPVLEV(k) * dPVLEV(k)/dPs)
* = sum_k (dH(i)/dZLNPI(k) * zpresb(k)/PVLEV(k))
*
* with ZPZ(k)=zpresb(k)/PVLEV(k) on input to LAYERAVG and
* ZPZ(i)=H(i) on output of LAYERAVG
*
* c) KFLAG=2 for adjoint case:
*
* PVI(i,jn) = PVI(i,jn) + sum_jo (PVO(jo,jn)*H(i))
* = PVI(i,jn) + sum_jo (ZPZ(jo,i))
*
* PPS(jn) = PPS(jn) + sum_jo (PVO(jo,jn)*sum_i (PVIG(i,jn)*dH(i)/dPs))
* = PPS(jn) + sum_jo (ZPZPS(jo))
*
*--------------------------------------------------------------------
#endif
IMPLICIT NONE
*implicits
#include "pardim.cdk"
#include "comdim.cdk"
#include "comgem.cdk"
*
INTEGER JI, JO, JN
INTEGER KNIDIM, KNI, KNO, KNPROF, KFLAG
C
REAL*8 PVLEV(KNIDIM,KNPROF)
REAL*8 PPO(KNO), PVO(KNO,KNPROF)
REAL*8 PVI(KNIDIM,KNPROF)
C
REAL*8 ZLNPI (KNI),ZPZ(KNI),ZPVI(KNI),ZPG(KNI),ZPS(KNI)
REAL*8 ZLNPO (KNO),ZPZPS,PSS
C
REAL*8 ZPRESB
REAL*8 ZC1,ZC2
C
C --- KFLAG defines type of calculation: 0=Forward, 1=TLM, 2=ADJ
C
KFLAG=0
C
C --- Apply weighted averaging
C
ZLNPO(1:KNO)=LOG(PPO(1:KNO))
PSS=0.0D0
ZPG(1:KNI)=0.0D0
ZPZ(1:KNI)=0.0D0
ZPS(1:KNI)=0.0D0
ZPZPS=0.0D0
C
DO JN = 1, KNPROF
ZLNPI(1:KNI)=LOG(PVLEV(1:KNI,JN))
PVO(1:KNO,JN)=0.0
C
DO JO=1,KNO
CALL LAYERAVG(KFLAG,ZLNPO,ZLNPI,PVI(1:KNI,JN),ZPG,KNO,KNI,
1 JO,PSS,PVO(JO,JN),ZPZ,ZPS,ZPZPS)
ENDDO
END DO
C
RETURN
END