*=*=*=*= integrd.html =*=*=*=*
SUBROUTINE integrd

SUBROUTINE integrd


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

      IMPLICIT NONE

c        ..........     Version  du 29/04/97    ..............

c   ..   modification de l'integration de  q   . 26/04/94 ..
c   ....   Si shema Van-leer pour advection de q , on n'integre pas  q
c      car q  a ete deja integre   dans vlsplt appele par vanleer   ...

c=======================================================================
c
cccccccccccccccccccccccccccccccccccccccccccc
c
c       VERSION MARTIENNE de integrd.F
c
c                sans traceurs!
c
cccccccccccccccccccccccccccccccccccccccccccc
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  iadv(nqmx), 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   test sur la positivite des pressions pour detecter
c   les instabilites

      DO ij =1,ip1jmp1
         IF(.NOT.pext(ij).GT.0.) THEN
           PRINT*,'pression extensive neg. au point ij=',ij
           PRINT*, pext(ij)
           STOP'dans integrd'
         ENDIF
      ENDDO

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    .........    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