source: lmdz_wrf/trunk/WRFV3/lmdz/plevel.F90 @ 1939

!
! $Header$
!
!c================================================================
!c================================================================
      SUBROUTINE plevel(ilon,ilev,lnew,pgcm,pres,Qgcm,Qpres)
!c================================================================
!c================================================================
      USE netcdf
      USE dimphy
      IMPLICIT none

!cym#include "dimensions.h"
!cy#include "dimphy.h"

!c================================================================
!c
!c Interpoler des champs 3-D u, v et g du modele a un niveau de
!c pression donnee (pres)
!c
!c INPUT:  ilon ----- nombre de points
!c         ilev ----- nombre de couches
!c         lnew ----- true si on doit reinitialiser les poids
!c         pgcm ----- pressions modeles
!c         pres ----- pression vers laquelle on interpolle
!c         Qgcm ----- champ GCM
!c         Qpres ---- champ interpolle au niveau pres
!c
!c================================================================
!c
!c   arguments :
!c   -----------

      INTEGER ilon, ilev
      logical lnew

      REAL pgcm(ilon,ilev)
      REAL Qgcm(ilon,ilev)
      real pres
      REAL Qpres(ilon)

!c   local :
!c   -------

!cym      INTEGER lt(klon), lb(klon)
!cym      REAL ptop, pbot, aist(klon), aisb(klon)

!cym      save lt,lb,ptop,pbot,aist,aisb
      INTEGER,ALLOCATABLE,SAVE,DIMENSION(:) :: lt,lb
      REAL,ALLOCATABLE,SAVE,DIMENSION(:) :: aist,aisb
!$OMP THREADPRIVATE(lt,lb,aist,aisb)      
      REAL,SAVE :: ptop, pbot
!$OMP THREADPRIVATE(ptop, pbot)      
      LOGICAL,SAVE :: first = .true.
!$OMP THREADPRIVATE(first)
      INTEGER i, k
!c
      REAL missing_val
!c
      missing_val=nf90_fill_real
!c
      if (first) then
        allocate(lt(klon),lb(klon),aist(klon),aisb(klon))
        first=.false.
      endif
      
!c=====================================================================
      if (lnew) then
!c   on rinitialise les rindicages et les poids
!c=====================================================================


!c Chercher les 2 couches les plus proches du niveau a obtenir
!c
!c Eventuellement, faire l'extrapolation a partir des deux couches
!c les plus basses ou les deux couches les plus hautes:
      DO 130 i = 1, klon
         IF ( ABS(pres-pgcm(i,ilev) ) .LT.                                           &
       &        ABS(pres-pgcm(i,1)) ) THEN
            lt(i) = ilev     ! 2
            lb(i) = ilev-1   ! 1
         ELSE
            lt(i) = 2
            lb(i) = 1
         ENDIF
  130 CONTINUE
      DO 150 k = 1, ilev-1
         DO 140 i = 1, klon
            pbot = pgcm(i,k)
            ptop = pgcm(i,k+1)
            IF (ptop.LE.pres .AND. pbot.GE.pres) THEN
               lt(i) = k+1
               lb(i) = k
            ENDIF
  140    CONTINUE
  150 CONTINUE
!c
!c Interpolation lineaire:
!c
      DO i = 1, klon
!c interpolation en logarithme de pression:
!c
!c ...   Modif . P. Le Van    ( 20/01/98) ....
!c       Modif Frederic Hourdin (3/01/02)

        aist(i) = LOG( pgcm(i,lb(i))/ pres )                                         &
       &       / LOG( pgcm(i,lb(i))/ pgcm(i,lt(i)) )
        aisb(i) = LOG( pres / pgcm(i,lt(i)) )                                        &
       &       / LOG( pgcm(i,lb(i))/ pgcm(i,lt(i)))
      enddo


      endif ! lnew

!c======================================================================
!c    inteprollation
!c======================================================================

      do i=1,klon
         Qpres(i)= Qgcm(i,lb(i))*aisb(i)+Qgcm(i,lt(i))*aist(i)
      enddo
!c
!c Je mets les vents a zero quand je rencontre une montagne
      do i = 1, klon
         if (pgcm(i,1).LT.pres) THEN
            Qpres(i)=missing_val
         endif
      enddo

!c
      RETURN
      END SUBROUTINE plevel