!-------------------------------------- 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 matapathr ( pvlev, palpha,knlev ) 1
C
*S/R MATAPATHR:
C     CALCULE LES ELEMENTS DE LA MATRICE TRIDIAGONALE ASSOCIEE A LA
C     SOLUTION PAR UN ALGORITHME DU 4EME ORDRE DE L'EQUATION
C     T*S**ALPHA=D(P)/DS OU T ET P SONT DEUX FONCTIONS ECHANTILLONNEES
C     AUX N NIVEAUX SIGMA. LES MATRICES GENEREES ICI SERONT UTILISEES
C     PAR LES SUBR. VTAP ET VPAT. L'ALGORITHME EST DU A J. COTE.
C     NOTE: ON CALCULE IMMEDIATEMENT DANS LE COMMON comode
C           LES COEFFICIENTS GENERES PAR LA REDUCTION GAUSSIENNE
C           LORS DU CALCUL DE T.
C
C AUTHOR: Michel Beland  - RPN AVRIL 1984 - ADAPTE AU MODELE SEF
C
C Revision: H. Ritchie - RPN JANVIER 1993 - RECODAGE
C
C         : L. Fillion - ARMA - Oct 96 - Adapted for 3DVAR
C         : L. Fillion - ARMA - 10 mar 99 - Add pps argument
C           C. Charette - ARMA/SMC - Sep. 2004
C            - Conversion to hybrid vertical coordinate
C              Replace argument pps by  pvlev, knlev.
C              Profile of pressure values is now input rather than
C              being calculated locally.
C
C ARGUMENTS:
C    I - PVLEV   : PROFILE OF PRESSURE VALUES
C    I - PALPHA  : EXPOSANT DE SIGMA.
C    I - KNLEV   : NUMBER OF PRESSURE VALUES
C
C NOTE:
C     VMA(I),VMBHR(I),VMCHR(I): DIAG. INF., PRINC., ET SUP. DE LA MAT.
C
C
      IMPLICIT  NONE
      integer knlev
      real*8  palpha, pvlev(knlev)
c
#include "comlun.cdk"
#include "comdimo.cdk"
#include "commvohr.cdk"
C
*implicits
      logical llprint
      INTEGER jl,jlev,im, ilen, ierr
      REAL*8 ZXM,ZX0,ZXP,ZAA,ZBB,ZEX,ZCC,ZQ(3),ZDD,ZDET
*modules
*
**
      llprint = .false.
c
      DO 20 jlev=1,KNLEV
      ZX0=PVLEV(jlev)
      IF (jlev.EQ.1) THEN
        ZXM=PVLEV(1)
        ZXP=PVLEV(2)
        ZAA=PVLEV(3)-ZX0
        ZBB=PVLEV(2)-ZX0
      ELSEIF (jlev.EQ.KNLEV) THEN
        ZXM=PVLEV(KNLEV-1)
        ZXP=PVLEV(KNLEV)
        ZAA=PVLEV(KNLEV-1)-ZX0
        ZBB=PVLEV(KNLEV-2)-ZX0
      ELSE
        ZXM=PVLEV(jlev-1)
        ZXP=PVLEV(jlev+1)
        ZAA=ZXM-ZX0
        ZBB=ZXP-ZX0
      ENDIF
      DO 10 jl=1,3
      ZEX=PALPHA+FLOAT(jl)
        IF(ZEX.NE.0.) ZQ(jl)=(ZXP**ZEX-ZXM**ZEX)/ZEX
        IF(ZEX.EQ.0.) ZQ(jl)=LOG(ZXP/ZXM)
   10 CONTINUE
      ZQ(3)=ZQ(3)-ZX0*(2.0*ZQ(2)-ZX0*ZQ(1))
      ZQ(2)=ZQ(2)-ZX0*ZQ(1)
      ZCC=ZAA**2
      ZDD=ZBB**2
      ZDET=ZAA*ZDD-ZBB*ZCC
      VMAHR(jlev)=(ZDD*ZQ(2)-ZBB*ZQ(3))/(2.0*ZDET)
      VMCHR(jlev)=(ZAA*ZQ(3)-ZCC*ZQ(2))/(2.0*ZDET)
      VMBHR(jlev)=ZQ(1)/2.0-VMAHR(jlev)-VMCHR(jlev)
   20 CONTINUE
*
*     COEFFICIENTS DE L'OPERATEUR INVERSE
*
      DO 30 jlev=1,KNLEV
      VMDHR(jlev)=VMAHR(jlev)
      VMEHR(jlev)=VMBHR(jlev)
      VMFHR(jlev)=VMCHR(jlev)
   30 CONTINUE
*
      VMDHR(1)=VMDHR(1)/VMFHR(2)
      VMEHR(1)=VMEHR(1)-VMDHR(1)*VMDHR(2)
      VMFHR(1)=VMFHR(1)-VMDHR(1)*VMEHR(2)
      VMFHR(KNLEV)=VMFHR(KNLEV)/VMDHR(KNLEV-1)
      VMDHR(KNLEV)=VMDHR(KNLEV)-VMFHR(KNLEV)*VMEHR(KNLEV-1)
      VMEHR(KNLEV)=VMEHR(KNLEV)-VMFHR(KNLEV)*VMFHR(KNLEV-1)
*
      VMEHR(1)=1.0/VMEHR(1)
      DO 31 jlev=2,KNLEV
      im=jlev-1
      VMFHR(im)=VMFHR(im)*VMEHR(im)
   31 VMEHR(jlev)=1.0/(VMEHR(jlev)-VMDHR(jlev)*VMFHR(im))
*
      if(llprint) then
        write(nulout,*)' '
        write(nulout,*)'matapathr: vmahr = ',vmahr
        write(nulout,*)' '
        write(nulout,*)'matapathr: vmbhr = ',vmbhr
        write(nulout,*)' '
        write(nulout,*)'matapathr: vmchr = ',vmchr
        write(nulout,*)' '
        write(nulout,*)'matapathr: vmdhr = ',vmdhr
        write(nulout,*)' '
        write(nulout,*)'matapathr: vmehr = ',vmehr
        write(nulout,*)' '
        write(nulout,*)'matapathr: vmfhr = ',vmfhr
        write(nulout,*)' '
      endif
c
      RETURN
      END