*=*=*=*= integvanl.html =*=*=*=*
SUBROUTINE integvanl

SUBROUTINE integvanl


      SUBROUTINE integvanl
     $   (  nq,vcovm1,ucovm1,hm1,pextm1,
     $     dv,du,dh,dq,dp,vcov,ucov,h,q,pext,phis,finvpold,unsfpnew )

      IMPLICIT NONE


c   ..   modification de l'integration de  q   . 26/04/94 ..

c=======================================================================
c
c   Auteur:  P. Le Van
c   -------
c
c   objet:
c   ------
c
c   Incrementation des tendances dynamiques
c
c=======================================================================
c-----------------------------------------------------------------------
c   Declarations:
c   -------------

#include "dimensions.h"
#include "paramet.h"
#include "comconst.h"
#include "comgeom.h"
#include "comvert.h"
#include "logic.h"
#include "temps.h"
#include "serre.h"

c   Arguments:
c   ----------

      INTEGER nq

      REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm),h(ip1jmp1,llm)
      REAL q(ip1jmp1,llm,nq)
      REAL pext(ip1jmp1),phis(ip1jmp1)

      REAL vcovm1(ip1jm,llm),ucovm1(ip1jmp1,llm)
      REAL hm1(ip1jmp1,llm),pextm1(ip1jmp1)

      REAL dv(ip1jm,llm),du(ip1jmp1,llm)
      REAL dh(ip1jmp1,llm),dp(ip1jmp1)
      REAL dq(ip1jmp1,llm,nq), finvpold(ip1jmp1), unsfpnew(ip1jmp1)

c   Local:
c   ------

      REAL vscr( ip1jm ),uscr( ip1jmp1 ),hscr( ip1jmp1 )
      REAL pscr( ip1jmp1 )
      REAL unspext( ip1jmp1 )
      REAL finvpext(ip1jmp1)
      REAL hppn(iim),hpps(iim),qppn(iim),qpps(iim),hpn,hps,qpn,qps

      INTEGER  l,ij,iq
      REAL  SSUM

      EXTERNAL  filtreg
      EXTERNAL  SCOPY
      REAL CVMGT

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

      DO 1 l = 1,llm
      DO 1 ij = 1,iip1
      ucov(    ij    , l) = 0.
      ucov( ij +ip1jm, l) = 0.
      uscr(     ij      ) = 0.
      uscr( ij +ip1jm   ) = 0.
   1  CONTINUE


c    ............    integration  de       pext         ..............

      DO 2 ij = 1,ip1jmp1
      pscr(ij)    = pext(ij)
      pext(ij)    = pextm1(ij) + dt * dp(ij)
   2  CONTINUE

c   #######      P.Le Van ( Modif le  26/04/94)    ##########

      CALL   SCOPY( ip1jmp1,pext,1,finvpext,1 )
      CALL filtreg( finvpext,jjp1,1,-2,2,.TRUE.,1 )

      DO 3 ij = 1,ip1jmp1
      unspext ( ij ) = 1./  pext  ( ij )
      unsfpnew( ij ) = 1./finvpext( ij )
   3  CONTINUE


c    ............   integration  de  ucov, vcov,  h     ..............

      DO 10 l = 1,llm

      DO 4 ij = iip2,ip1jm
      uscr( ij )   =   ucov( ij,l )
      ucov( ij,l ) = ucovm1( ij,l ) + dt * du( ij,l )
   4  CONTINUE

      DO 5 ij = 1,ip1jm
      vscr( ij )   =   vcov( ij,l )
      vcov( ij,l ) = vcovm1( ij,l ) + dt * dv( ij,l )
   5  CONTINUE

      DO 6 ij = 1,ip1jmp1
      hscr( ij ) =    h(ij,l)
      h ( ij,l ) = hm1(ij,l) *  pextm1(ij) * unspext(ij)
     $                + dt * dh(ij,l) * unspext(ij)
   6  CONTINUE


c   ....  Calcul de la valeur moyenne, unique  aux poles pour  h    ......
c    .........     P. Le Van  ( ajout le 17/04/96 )   .........
c
c
      IF( alphax.NE.0. )   THEN
        DO  ij   = 1, iim
        hppn(ij) = aire(   ij   ) * h(  ij    ,l)
        hpps(ij) = aire(ij+ip1jm) * h(ij+ip1jm,l)
        ENDDO
        hpn      = SSUM(iim,hppn,1)/apoln
        hps      = SSUM(iim,hpps,1)/apols

        DO ij   = 1, iip1
        h(   ij   ,l)  = hpn
        h(ij+ip1jm,l)  = hps
        ENDDO
      ENDIF
c
c  .........................................................................

      IF(leapf)  THEN
         CALL SCOPY ( ip1jmp1, uscr(1), 1, ucovm1(1, l), 1 )
         CALL SCOPY (   ip1jm, vscr(1), 1, vcovm1(1, l), 1 )
         CALL SCOPY ( ip1jmp1, hscr(1), 1,    hm1(1, l), 1 )
      END IF

  10  CONTINUE

c
c    .............      integration de   q    ........................
c
c   ######   P.Le Van ( Modif le  26/04/94 )   ########

c          ancienne formul.  Z.X.Li
c  q(ij,l,iq)=( qm1(ij,l,iq)*pscr(ij) +dtvr*dq(ij,l,iq) )* unspext(ij)
c     ou  ....  q(ij,l,iq) = qm1(ij,l,iq) * pscr(ij)* unspext(ij)
c
c
c    .....        P.Le Van ( ajout  le 17/04/96 )     ........
c    .....  Calcul de la valeur moyenne, unique  aux poles pour  q .....
c
      IF( alphax.NE.0. )   THEN

        DO iq = 1, nq
          DO l = 1, llm

             DO ij = 1, iim
             qppn(ij) = aire(   ij   ) * q(   ij   ,l,iq)
             qpps(ij) = aire(ij+ip1jm) * q(ij+ip1jm,l,iq)
             ENDDO
             qpn  =  SSUM(iim,qppn,1)/apoln
             qps  =  SSUM(iim,qpps,1)/apols

             DO ij = 1, iip1
             q(   ij   ,l,iq)  = qpn
             q(ij+ip1jm,l,iq)  = qps
             ENDDO

          ENDDO
        ENDDO

      ENDIF

c
c    .........    FIN  de l'integration  de   q    .................
c
c
         CALL  SCOPY( ip1jmp1,finvpext,1,finvpold,1 )
c
c    .................................................................


      IF( leapf )  THEN
         CALL SCOPY ( ip1jmp1, pscr, 1,   pextm1, 1 )
      END IF

      RETURN
      END