*=*=*=*= exner_new.html =*=*=*=*
SUBROUTINE exner_new

SUBROUTINE exner_new


      SUBROUTINE exner_new(ngrid,pext,filtpks,pks,pksf)
c
      IMPLICIT NONE

c    Auteurs :  P.Le Van, F. Hourdin
c
c-----------------------------------------------------------------------
c     Calcule la fonction d'Exner pks = pnat ** kappa  et eventuellement
c                  pks filtre ,  si filtpks = . true.
c-----------------------------------------------------------------------
c   declarations:
c   -------------

#include "dimensions.h"
#include "paramet.h"
#include "comconst.h"
#include "comgeom.h"
#include "serre.h"

c    .............       Arguments      .....................
c
      INTEGER ngrid
      REAL pext(ngrid),pks(ngrid),pksf(ngrid)
      LOGICAL filtpks
c
c
c    ...........   Variables  locales   ......................

      INTEGER ig
      REAL pksairen( iim ), pksaires( iim ), pkspoln, pkspols
      REAL SSUM

      EXTERNAL filtreg, SSUM

c-----------------------------------------------------------------------

      DO 3 ig = 1,ngrid
        pks( ig )     = ( pext( ig )/ aire( ig ) ) ** kappa
  3   CONTINUE

c    .....         P. Le Van  ( ajout  le 17/04/96 )           .......
c    .....    Calcul de la valeur moyenne de pks  aux poles   ........
c
      IF( alphax.NE.0. )  THEN

       DO 4 ig = 1, iim
         pksairen( ig ) = pks(     ig    ) * aire(    ig      )
         pksaires( ig ) = pks( ig+ ip1jm ) * aire( ig + ip1jm )
  4    CONTINUE

       pkspoln =  SSUM( iim,pksairen,1 ) / apoln
       pkspols =  SSUM( iim,pksaires,1 ) / apols
       DO 5 ig = 1, iip1
        pks(    ig     ) = pkspoln
        pks( ig+ ip1jm ) = pkspols
  5    CONTINUE

      ENDIF

      DO ig = 1, ngrid
        pksf( ig ) = pks ( ig )
      ENDDO
c
      IF ( filtpks )   THEN
         CALL filtreg ( pksf, jjp1, 1, 2, 1, .TRUE., 1 )
      ENDIF

      RETURN
      END