!-------------------------------------- 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 calcpres(ppres,phybm,knbrlev,pps,ppt,pref,pcoef,kprof) 29
      implicit none
c
#if defined (DOC)
*
***s/r CALCPRES - Computes pressure values on eta levels
*
*Author  : S. Pellerin *ARMA/AES April 2000
*Revision:
*           C. Charette - ARMA/SMC - Sept 2004
*            - Conversion to hybrid vertical coordinate
*
*    -------------------
**    Purpose: Computes pressure values associated with profiles
*              of constant eta levels given 2 dimensionnal surface
*              pressure and top pressure values.
*
*Arguments
*    Onput :
*           ppres(knbrlev,kprof) : profiles of pressure values
*    Input :
*           phybm(knbrlev)        : values of normalized or unnormalised hybrid levels
*           knbrlev              : number of levels
*           pps(kprof)           : surface pressure values
*           ppt                  : top level pressure value
*           pref                 : reference pressure level
*           pcoef                : coefficient
*           kprof                : number of profiles
*
************************************************************************
#endif
#include "comlun.cdk"
      integer knbrlev,kprof,jlev
      real*8 ppres(knbrlev,kprof),phybm(knbrlev),pps(kprof)
      real*8 ppt,pref,pcoef
c
      integer jprof
      real*8 zpresa,zpresb,zhybm(knbrlev),zerrtol
c
      zerrtol = 1.0 /(2.0**17)              ! Tolerance from convip
c
      if(phybm(1) .lt. zerrtol) then ! normalized levels
        do jlev  = 1,knbrlev
          zhybm(jlev) = phybm(jlev) + (1.0D0-phybm(jlev))*ppt/pref
        enddo
      else
        do jlev  = 1,knbrlev
          zhybm(jlev) = phybm(jlev)
        enddo
      endif

      do jprof   = 1, kprof
        do jlev  = 1,knbrlev
          zpresb = ((zhybm(jlev) - ppt/pref)
     &               /(1.0D0-ppt/pref))**pcoef
          zpresa = pref * (zhybm(jlev)-zpresb)
          ppres(jlev,jprof) = zpresa + zpresb*pps(jprof)
c          if(jprof.eq.1) then
c            write(nulout,*)'calcpres:jlev,jprof,ppt,pref,pcoef ',jlev
c     &           ,jprof,ppt,pref,pcoef
c            write(nulout,*)'calcpres:phybm,zhybm,pps,ppres '
c     &           ,phybm(jlev),zhybm(jlev)
c     &           ,pps(jprof),ppres(jlev,jprof)
c          endif
        enddo
      enddo
c
      return
      end